22000090000 00000000000000000 ‘Computer program to perform transformations APPENDIX 2 Program listing PROGRAM TRSMAP THIS PROGRAM COMPUTES TRANSFORMED MAPS FROM MAGNETIC OR GRAVIMETRIC DATA. THE INPUT DATA SHOULD SE GIVEN ON A REGULAR RECTANGULAR GRID THE PROGRAM HAD BEEN WRITTEN ON A PRIME 350 COMPUTER. IT 1S NECESSARY TO MODIFY SOME SPECIFIC PRIME SUBROUTINES USED TO OPEN INPUT/OUTPUT DATA FILES (CALL OPENSA FOR EXAMPLE) ONE CAN TRANSLATE THIS IN FORTRAN 77 USING THE “OPEN” INSTRUCT ON AUTHORS: [Link] 8 D GIBERT INSTITUT DE PHYSIQUE DU GLOBE DE PARIS UNIVERSITE "PIERRE ET MARIE CURIE" 4 PLACE JUSSIEU -- TOUR 24-14 75005 PARIS -- FRANCE IMPLICIT DOUBLE PRECISION (A-H.0-Z) INTEGER. NOM# (20) .NOM2 (20) ,NOM3(20) , NOMA (20) INTEGER NOMS (20) , NOM6(20) ,NOM7(20) INTEGER TITRE( 10) . [TERV(8283) REAL CART4 (110000) , TEST, XORT. YORT DIMENSION W(5004 } , ZONE (10001) .INDIC(40) COMMON /TUB/CART4 /TEB/W. /OMZONE/ZONE LMES=1 ILeC=4 LUNITH=5, LUNIT2=6 CONVERSATIONAL PART WRITE (LMES , 1000) 11000 FORMAT(1OX, "PLEASE, SELECT ONE OPTION," /. 12x, 8'4 => COMPUTATION OF & FILTER ONLY’. /.12X, 8'2 «> READING OF A FILTER IN A FILE AND CONVOLUTION’ ,/. 12x 8'3 => COMPUTATION OF A FILTER AND CONVOLUTION’, //) READ(ILEC, +) INDIC(1) GO TO (3.2.2), INDIC(1) INPUT DATA FILE OPENING ON THE LUNIT4 FORTRAN UNIT HEADF ILE DECODING AND TYPING 2 WRITE(LMES, 1001} 1001 FORMAT(SX. ‘MAP BINARY FILENAME, ") 10 12 3 14 15 16 7 18 19 20 2i 2 23 24 25 26 2 28 29 30 31 32 33 34 38 36 37 38 39 40 al 42 43 4a 48 46 a7 48 49 50 51 52 53 54 55 56 37 58 59564 D. Ginerr and A. GALDEANO READ(ILEC,1002) NOM2 SPECIFIC PRIME SUBROUTINE THIS SUBROUTINE OPENS A FILE SUCH THAT? = INTS(1) => READONLY OPENING = NOM2 => FILENAME = INTS(@O) => MAXIMUM LENGTH OF THE NAME IS 80 CHARACTERS = INTS(LUNIT1-4) => THE FORTRAN UNIT NUMBER IS LUNITL CALL OPENSA( INTS(1) -NOM2, INTS(8O), INTS(LUNIT1~4)) READ(LUNIT1, 1003) NLIG-NCOL., IDEC, JDEC, TITRE-OX,[Link]-AZIMLI- 8XORI, YORI -ALT-DECNO,DIPNO,NOM7 1003 FORMAT(4(5X, 15), 1084, /,2(5X/F542)/4K,F7 01/3X,FGe1/2(5X/E15.8) 8//,9X,6743,6X-FGo1/6X/FG.1+///20A4) VRITE(LMES, 1004) TITRE-NOM7-NCOL-DY-AZINLI-NLIG-DX-ALT- TEST. 20ECNO,DIPNO 1004 FORMAT(////10X, "TITLE OF THE MAP TO BE PROCESSED: * 8, /// 12X46 ( Hm) +/, 12K LH 44K, LHe, 7 12X, Lm, 2X, 10A4 2X, LHe / > 12K, La, 64K, LH, /, 12K, 48 (1H) //, 10K, 'SUB-TITLES 4/7, B1X,20A4./, RSX, "THIS SURVEY IS COMPOSED OF +15," FLIGHT LINES’+/- 230K, ‘THE INTERVAL BETWEEN TWO LINES IS'-FS.2." KM'./, @30X, ‘AZIMUT OF LINES+".FGe1, 'OEGREES’./, @30X, "EACH LINE COUNT’, 15," POINTS SPACEO BY',F5.2," KM'o/+ @30X, “ALTITUDE (ABOVE SEA LEVEL): 4F703.'KH's/, /,5K, "THE LACK VALUE 1S'-F8.0,//, 25K, ‘NORMAL FIELO PARAMETERS: DECLINATION "FGele/ @31X, "INCLINATION =",FGe1) GO TO (3,7,3),INDICUL? c C QUESTIONS ABOUT THE FILTER FILES c 3 INDIC(2)=1YESNO( FILTER BINARY FILE*.18-LMES) IFCINDIC(2)4EG60) GO TO 4 WAITE(LMES, 1005) 1005 FORMAT( 10K, "FILENAME: /) READ( ILEC, 1002) NOMS VRITECLMES, 1006) 1006 FORMAT(10X, ‘ENTER A LINE OF COMMENTS: ',/1 READCILEC, 1002) NOM 4@ INOIC(3)=1YESNO( "FILTER DECIMAL FILE */20,LMES) IFCINDIC(3)+E020) GO TO 6 IFCINDIC(2).NE.O) GO TOS WRITE(LMES, 1006) READCILEC, 1002) NOMI 5 CONTINUE VAITE(LMES. 1005) READ(ILEC, 1002) NOME 6 IFCINDIC(1)4€Q61) GO TO 13 co To 8 c © READING THE FILTER BINARY FILE c 7 WAITE(LMES, 1007) 1007 FORMAT( 10x, "FILTER FILENAME: *./) READ( ILEC, 1002) NOMA 1002 FORMAT( 2044) C SPECIFIC PRIME SUBROUTINE c 60 61 62 63 6a 6S 65 87 68 63 70 7 72 73 24 73 76 77 78 73 80 a1 82 83 aa 85 86 a7 88 89 30 31 92 93 8a 95 96 97 ee 93 100 101 loz 103 104 105 108 107 108. tos no u 2 13 na us 16 17 le‘Computer program to perform transformations 568 © THIS SUBROUTINE OPENS A FILE SUCH THAT: 120 c = INTS(1) => READONLY OPENING 121 c = NOMA => FILENAME 122 © = INTS(@0) => MAXIMUM LENGTH OF THE NAME IS 80 CHARACTERS 123 c = INTS(LUNIT2-4) => THE FORTRAN UNIT NUMBER IS LUNIT2 lea CALL OPENSA(INTS(1) NOMA, INTS(80)-INTS(LUNIT2—4 )) 125 READ(LUNIT2, 1008) INDIC(S)-M-N-NOMS. 126 1008 FORMAT( 2ax,12,10X-15,3x,15-/+20A4) 127 WRITE(LMES, 1003) M,N/NOMS 128 1009 FORMAT( 10x, ‘THE SIZE OF THE FILTER IS+',IS-" x '-15-/,20A4) 128 8 INDIC( 4)=1YESNO( "DATA BORDERING’, 14/LHES? 130 WRITE(LMES, 1010) 131 1010 FORMAT(10X, "ENTER THE CONVOLUTION PARAMETERS: ",/.10X, 132 ROIXT, IXP-JYT/JYFINCX, INCY'2/) 133 READ ILEC x) 1X1, IXF, JY], JYF/INCK, INCY 134 WRITE(LMES, 1011) 135, 1011 FORMAT( 1X, "OUTPUT BINARY FILENAME: ',/) 136 READ( ILEC, 1002) NOMS 137 VRITE(LMES, 1006) 138 AEAD( LEC. 1002) NOM 138, 9 CONTINUE 140 ¢ 141 © ex90000000000000000000000006 142 cx « Las © COMPUTATIONAL PART x 144 Cone x 145, C:eneenaaHEDDOEEEREEREE ROO. 146 c 147 c 148, C COMPUTATION OF THE FILTER WITH CALCOP 143 c 150 IFCINDIC(1) +023) 151 CALL CALCOP(LMES, ILEC,OXmINCK-OYwINCY DECNO-OIPNO-AZIMLI. 1s2 M,N, INDIC.M, ZONE) 133 c 15a C READING THE FILTER BINARY FILE 155 c 156 IFCINDIC(L).NE«2) GO TO 11 157 IFCINDIC(S)«£0.3) GO TO 10 1s8 IFCINDIC(S)«EQ61) CALL ECLEC(W,(M+1 1/2, (N41 )/2/LUNIT2,-1) 159 IFUINDIC(S)«£0.2) CALL ECLEC(W,M,N/LUNIT2,—1) 160 10 END FILE LUNIT2 ne 11 CONTINUE 162 c 163 COMPUTATION OF FUNDAMENTAL SUBSCRIPTS 164 c 165 LxPatmet 1/2 166 KYP=(Ne1)/2 167 IDECAL=0 168 JDECAL=O 168 IFUINDIC(4?4£Q40) GO TO 12 170 IDECAL=LXP-1 171 JDECAL=KYP-1 172 12 CONTINUE 173 NPX=NLIG+2e DECAL va NPY=NCOL+2xJDECAL 175 WRITE(LMES, 1012) 178 c 177 © READING THE INPUT DATA FILE 178 c 178566 D, GipeRr and A. GALDEANO 1012 FORMAT(10X, "READING THE DATA") CALL LECTUR( CART! -NPX,NPY, [DECAL JDECAL. TEST -LUNITI) ENO FILE LUNITI TAPERING THE OATA WRITE(LMES, 1013) 1013 FORMAT(10X, 'TAPERING THE DATA") CALL JUPE2( CART -NPX, NPY, ZONE, TEST, ITERV,LMES) OPENING OF THE OUTPUT BINARY FILE ON THE LUNIT2 FORTRAN UNIT WRITING THE S LINES HEADFILE SPECIFIC PRIME SUBROUTINE THIS SUBROUTINE OPENS A FILE SUCH THATS = INTS(2) => WAITEONLY OPENING NOM3 => FILENAME = INTS(80) => MAXIMUM LENGTH OF THE NAME IS 80 CHARACTERS: =_INTS(LUNIT2-4) => THE FORTRAN UNIT NUMBER IS LUNIT2 CALL OPENSA( INTS(2) NOMS, INTS(BO) + INTS(LUNIT2-4) ) XI+1 YI-1+JDEC WAITE(LUNIT2, 1014) [Link], IOEC, JDEC, TITRE OX, DY, TEST, @AZIMLI,XORI, YORI, ALT, DECNO,D1PNO, NOM? 1014 FORMAT( 'NUIG=", 15, ‘NCOL="-I5, "IDEC=",15, ‘JDEC="-15,10A4,/. B°EC aL =! F542, ECeC=!-FS42,'VID="/F7e1, ‘AZ=" FGo1, Q°XORI="-E15.8, 'YORI="-E15.8./+ a ‘ALTITUDE=" F743, 'DECNO="-FGe 1, ‘OPN @80( Ie }+/+20A4) FFG o1 40 LHe do CONVOLUTION CASE WHERE THE INDEX FILTER IS 1 (SYMMETRY PROPERTIES) IFCINDIC(S)+EQei) CALL CONVOL(W-LXP/KYP, IX1+IDECAL, IXF+IDECAL,JYT+ RJDECAL, JYF+JDECAL, INCX, INCY ,CART1 - ZONE -NPX,NPY, TEST -LUNIT2, eLMES. ITERV) CASE WHERE THE INDEX FILTER IS 2 (NO SYMMETRY) IFC INDIC(S) +022) CALL CONVPO(W,M/N, IXI+IDECAL, IXF+ IDECAL- JY I+ JDECAL, JYF+JDECAL. INCK. INCY-CART1 -ZONE /NPX, NPY, TEST LUNIT2, @LMES, ITERV) END FILE LUNIT2 IFCINDIC(1)+£063) GO TO 14 STOP THIS PROGRAM SECTION IS RELATIVE TO THE CASE OF THE COMPUTATION OF A FILTER ONLY 13 CALL CALCOP(LMES, ILEC,OX-0Y,$99-00,999.00,AZIMLI/M.N, INDIC, ¥.ZONE} STORAGE OF THE FILTER IN A BINARY FILE 141015 1016 15 1017 16 ‘Computer program to perform transformations JN=N IFCINDIC(S)«£Q43) GO TO 16 IFCINDIC(S)«EQe1) IM=(M419/2 TFCINDIC(5) «EQe1) JN=(N+11/2 IFCINDIC(2),£0.0) GO TO 15 WAITE(LMES, 1015) FORMAT(10X, 'NOWs CREATING THE FILTER BINARY FILE‘) CALL OPENSA( INTS(2) NOMS. INTS( 80), INTS(LUNIT2-<))) WAITE(LUNIT2, 1016) INDIC(S)-M-N/NOML FORMAT( "++ FILTER FILE + INOEX =',12,' SIZE + M='-IS," Net-15. @/,20A4) CALL ECLEC(W, IM, JN,LUNIT2,1) END FILE LUNIT2 IFCINDIC(3)4EQ40) GO TO 16 STORAGE OF THE FILTER IN A DECIMAL FILE WRITE(LMES, 1017) FORMAT(10X, ‘NOW: CREATING THE FILTER DECIMAL FILE’ CALL OPENSA( INTS(2),NOMB, INTS(80), INTS(LUNIT2~4)) CALL OBOOK(. IM, 1-IM-1,JN-2-4-LUNIT2) ENO FILE LUNITZ sToP ENO SUBROUTINE CALCOP(LMES, ILEC-0X,DY,DECNO,OIPNO,AZIMLI/M/N- INDIC, 8N- ZONE) THIS SUBROUTINE CONTAINS BOTH THE CONVERSATIONAL AND COMPUTATIONAL PARTS CONCERNING THE FILTER CALCULATIONS. INPUT ARGUMENTS OESCRIPTION+ - LMES => SCREEN FORTRAN UNIT NUMBER = OX/DY => SAMPLING INTERVAL IN KH = DECNO DECLINATION AND INCLINATION OF THE NORMAL FIELO = AZIMLI => AZIMUT OF THE FLIGHT LINES: OUTPUT ARGUMENTS DESCRIPTION: = M/N => TOTAL DIMENSIONS OF THE FILTER = INDIC => AN INDICATOR ARRAY = W => MATRIX OF THE FILTER COEFFICIENTS STORED COLUMNWISE = ZONE => AUXILIARY STORAGE ARRAY REMARKS: IF DECNO=DIPNO=993. THE VALUES OF OX,OY/OECNO-DIPNO,AZ ARE ASKED FOR DURING THE EXECUTION OF CALCOP PANT IS AN ARRAY WHICH CONTAINS THE PARAMETERS OF THE FILTERS c = ANISOTROPY COEFFICIENT AZIMUT = AZIMUT OF THE FLIGHT LINES H CONTINUATION OFFSET OR DEPTH OF THE TOP OF THE LAYER oN DECLINATION OF THE NORMAL FIELD IN INCLINATION OF THE NORMAL FIELD oA DECLINATION OF THE MAGNETIZATION VECTOR IA INCLINATION OF THE MAGNETIZATION VECTOR € THICKNESS OF THE LAYER N = ORDER OF THE VERTICAL DIFFERENCLATION OR ORDER OF THE “RESTE” DEVELOPMENT PRHT(7,J) IS EQUAL TO THE CODE OF THE JST ELEMENTARY 2a0 241 242 2a3 2aa 24s 246 207 248 249 250 251 252 233 254 258 256 257 258 259 280 261 262 263 264 285 286 257 268 269 270 271 272 273 274 275 276 277 278 273 280 281 282 283 2e4 285 286 287 288 2e3 280 231 292 233 234 295 236 237 238 299 567568 c 1001 FORMAT(SX, "axe CALCOP 1002 FORMAT(Sx. D. GIBERT and A. GALDEANO OPERATION PRMT 4 101 PROL c DERI c N 102 [Link] co oH € 105 [Link] co oH € 104 [Link], CON IN| DATA AZIMUT. 202 RED-EQU CON IN DA IA AZIMUT 202 [Link] COON IN| DATA AZIMUT. 203 “RESTE* cow N 108 IMPLICIT DOUBLE PRECISION (A-H,0-2) DIMENSION W(1),ZONE(1), INDIC(10),PRMT(7, 10) EXTERNAL GOERI,GPROL,AMINV, GINV,RPOLE-REQUA, INTGA, RESTE -RESTP DATA NOE/O/, IFLGPO/O/-MAXTYP/0/ IF ((OABS(DECNO).GT«360-00)ORe(DABS(OIPNO).GT.90400)) GO TO 2 TFLGPO = 1 1 WRITECLMES. 1000) 1000 FORMAT(SX. "ENTER M AND Ne'+/) READCILEC.m) HeN IF(MOD(N,2)4EQe1 eANDs MODIN,2)4£Ge1) GO TO 3 WRITE(LMES, 1001) - M @ N MUST BE ODD" 60 TO 1 2 WRITE(LMES. 1002) COMPUTATION OF A FILTER ONLY, PLEASE ENTER’, @' M,N, OX AND DYE") READ(ILEC, x) M/N-OX/OY IF(MOO(M,2)sEQs1 sANDe MOD(N,2)+EQ21) GO TO 3 VRITECLMES. 1001) co 10.2 3 CONTINUE Lxstt419/2 KY=(N+10/2 ANISO = DX/DY 4 CONTINUE NOE = NOE +1 5 WRITECLMES, 1003) 1003 FORMAT(/.5X, "PLEASE, SELECT ONE OPTION #',/, $12X," 1 => UPWARD OR DOWNWARD CONTINUATION". /, S12X." 2 => VERTICAL DIFFERENTIATION’, /, $12X," 3 => INVERSION (MAGNETISH, RePs MADE)‘./+ $12X," 4 => INVERSION (GRAVIMETAY)*,/, $12X,' 5 => REDUCTION TO THE POLE’./, 12x," 6 => REDUCTION TO THE EQUATEUR'./, $12X," 7 => PSEUDO-GRAVIMETRIC INTEGRATION OF MAGNETIC OATA'./, $12X," @ => ESTIMATION OF THE '*RESTE*'") READ(LMES, x) INDIC(7) GO TO (6-7+10/9, 12,12, 12,8), INDICK7) WRITE(LMES. 1004) 1004 FORMAT( 10x, "wma CALCOP --~ INCORRECT ANSWER xox") co ToS CONTINUATION 6 WAITE(LHES, 1005) 1005 FORMAT( 10x, "CONTINUATION OFFSET (+ DOWNWARD)" ) READ(ILEC-m) H 300 301 302 303 30a 308, 308 307 08 303 310 Bll 312 313 aia 315 316 317 318, a9 320 321 322 323 324 325 326 327 328 329 350 331 332, 333 334 335 336 337 338 338 340 Bai 342 343 Baa 345 346 347 348 343 350 351 352 353 354 355 356 357 358 3591007 1008 10 12 1003 13 ‘Computer program to perform transformations PAMT(1/NOE) = ANISO PRMT(2/NOE)=H/DY PRMT(7,/NOE) = 1016 HAXTYP = MAKO(MAXTYP, 1) Go 1015 DIFFERENTIATION WRITE(LHES, 1006) FORMAT( 10X, 'OROER OF DIFFERENTIATION ( >0)") READ( ILEC.) PRHT(4-NOE) PRMT(1,NOE) = ANISO PRMT(7,NOE) = 102 MAXTYP = MAXO(MAXTYP. 1) co To 15 RESTE VAITE(LMES. 1007) FORMAT(10X. ‘DEPTH AND ORDER OF THE DEVELOPMENT: *) READ(ILEC,«) H/PRHT(4-NOE) PRHT(1,NOE) = ANISO PRMT(2-NOE) = H/OY PRMT(7,NOE) = 103. MAXTYP = MAXO(MAXTYP. 1) Go TO 18 INVERSION (GRAVIMETRY } VRITE(LMES. 1008) FORMAT(10X. ‘DEPTH AND THICKNESS OF THE LAYERS") REAO(ILEC.m) HE PRHT(1,NOE) = ANISO PRHT(2-NOE)=H/DY PRHT(3,NOE)=E/0Y PRHT(7,NOE) = 104. MAXTYP = MAXO(MAXTYP. 1) Go TO 15 INVERSION (MAGNETISM - REOUCTION TO THE POLE MADE) VRITE(LMES. 1008) READUILEC-m) HE PRHT(1-NOE) = ANISO PRNT(2,NOE PRHT(3/NOE PRMT(7,NOE) = 105. MAXTYP = MAXO(MAXTYP, 1) co TO 15 REOUCTION TO THE POLE OR TO THE EQUATOR IF([Link].1) GO TO 13 VAITE(LMES, 1009) FORMAT(10X, "ENTER OECNO-OIPNO-AZIMLI#*-/) READ(ILEC.«) PRHT(2,NOE),PRMT(3,NOE),PRMT(6,NOE) GO TO 14 PRMT(2-NOE) = DECNO PRHT(3/NOE) = DIPNO PRMT(G,NOE) = AZIMUT 563 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 373 380 301 382 303 38a 385 386 387 368 369 380 391 392 393 394 395 296 397 398 393 400 ant 402 403 404 408 406 407 408 403 410 aut a2 413 aia 415 416 a7 ais as570 D. GineRt and A. GALDEANO 14 WRITE(LMES. 1010) 1010 FORMAT(SX, "DECLINATION AND INCLINATION OF THE MAGNETIZATIONs *) READ(ILEC.«) PRMT(4,NOE),PRMT(S,NOE ) PAMT(1/NOE) = ANISO PRMT(7/NOE) = 200 + INDIC(7) - 4 MAXTYP = MAXO(MAXTYP,2) Go 10 15 1S CONTINUE IQUEST = IYESNO( ‘OO YOU WANT ANOTHER OPERATION *,30/LMES) IF(IQUESTsEG.1) GO TO 4 IF([Link]+1) CALL FILTRE(W,LX-KY,NOE, RMT. ZONE. LNES, IER) IF(MAXTYP.E0.2) CALL POLEO(W.M,N-NOE,PRMT, ZONE-LMES, TERR) INDIC(S) = MAXTYP RETURN END SUBROUTINE POLEO(W-M-N-NOE,[Link]-LMES. IERR) THIS SUBROUTINE COMPUTES A FILTER WHOSE RESULTANT INDEX IS 2 INPUT ARGUMENTS DESCRIPTION: = LMES => SCREEN FORTRAN UNIT NUMBER. = PANT => THE ARRAY OF THE ELEMENTARY FILTERS PARAMETERS > NUMBER OF ELEMENTARY FILTERS => TOTAL NUMBER OF THE FILTER LINES > TOTAL NUMBER OF THE FILTER ROWS QUTPUT ARGUMENTS DESCRIPTION: = V=> AN ARRAY WHICH CONTAINS THE FILTER COEFFICIENTS STORED STOREO COLUMNWISE = ZONE => AUXILIARY STORAGE ARRAY = IERR => AN ERROR INDICATOR REMARKS: HAND N MUST BE OOD ZONE MUST CONTAIN AT LEAST Mw(N+1) REALMS LOCATIONS IMPLICIT OOUBLE PRECISION(A-H.0-2) DIMENSION W(H/N),ZONEC1),PRMT(7 ,NOE) KY=(N11/2 T=twkY+1 IF([Link].0) WAITE(LMES, 1000) NOE 1000 FORMAT(SX, ‘++ SUBROUTINE POLEG ++ NUMBER OF ELEMENTARY’, 2" OPERATIONS: *, 13) CALL POLEG!(M,N/NOE/PRMT, ZONE, ZONE( 11), TERR? CALL TFPOEQ(W,M,[Link],ZONE(T1)-LMES) RETURN END SUBROUTINE POLEOI(M,N,[Link],[Link]- TERR) THIS SUBROUTINE COMPUTES THE REAL AND IMAGINARY PARTS OF THE FOURIER TRANSFORM OF A FILTER WHOSE RESULTANT INDEX IS 2 INPUT ARGUMENTS DESCRIPTION: - PRHT => THE ARRAY OF THE ELEMENTARY FILTERS PARAMETERS = NOE => NUMBER OF ELEMENTARY FILTERS = M => TOTAL NUMBER OF THE FILTER LINES = No=> TOTAL NUMBER OF THE FILTER ROWS: OUTPUT ARGUMENTS DESCRIPTION: = GREEL => REAL PART OF THE FOURIER TRANSFORM 420 a2i 422 423 aaa 425 428 427 428 423 430 431 432, 433, 434 435, 436 437 438 433 ao 4al 4ar 443 44a 445; 246 447 248 43 450 451 452 453 454 435 436 457 458 459 460 461 462 463 464 465 468 487 488 463 470 art 472 473 474 47s 476 477 4a 473‘Computer program to perform transformations = GIM => IMAGINARY PART OF THE FOURTER TRANSFORM = IERR => AN ERROR INDICATOR REMARKS+ GREEL AND GIM MUST CONTAIN EACH Ha(N+1)/2 REALMS LOCATIONS IMPLICIT DOUBLE PRECISION (A-H,0-2) DIMENSION PRNT(7,NOE)-GREEL(M,1),GIM(M/1) COMMON/PARANO/PI, DEUXPI COMMON/PARAM /PARI /PARZ. PARS, NORD COMMON/PARAM2/[Link], GAMA, ALAM ANU, ANU, ® GAMA2, ANU2,GAMANU, CAZIM-SAZIM PI = 3,14159265358979300 DEUXP = PI+PI RAD = PI/180.00 C = PRMTC1,1) KY = (NS11/2 Lx = (Me11/2 cM = 1400 7 (CaM) N= 1.00 7N 00 1 DO 1 T=1-4 GREEL(I,J)=1.00 GIMCT,J)=0.00 CONTINUE COMBINATION OF THE ELEMENTARY FILTERS WHICH INDEXES ARE 2 ’ 00 7 10E=1,NOE IF(PRMT(7, 10E) «GE #300.00-0R-PANT(7-10E)+L72200400) CO TO 7 COMPUTATION OF THE DIRECTION COSINES DECNO = PRNT(2,10E) » RAD DIPNO = PRMT(3,10E) « RAD DECAT = PRNT(4,10E) « RAD DIPAI = PRMT(S,IOE) » RAD AZIM = PRMT(6,10E) ™ RAD ECO = (DECNO-AZIM) DIPO = DIPNO DEC] = (OECAY-AZIM) DIP! = OPAL BETA = OCOS(OIPO)x0SIN( DECO) ALEA = ~DCOS(DIPO)mOCOS(DECO) GAMA = -DSIN(DIPO) AMU = OCOS(DIPL)wOSIN( DECI) ALAM = -0COS(OIPI )mOCOS(OEC1) ANU = -OSIN(OTPL) GAMA2 = GAMAMGAHA ANU2 = ANUMANU GAMANU = GAMAMANU CAZIM = - DCOStAZIM) SAZIM = = OSIN(AZIM) ITOE = TABS INT(SNGL(PRNT(7.10E))+045)) ITM = ITOEWO.01 ITE = ITE - 200 IFCITMeNE#2) GOTO 17 Do 6 k= 1-KY OK = (KT. MCN sm 480 481 482 483 aaa 435 496 437 498 483 430 431 432 493 aga 435 436 437 438 aso 500 501 502 503 504 505 506 307 S08 503 510 5iL 512 513 sia 315 S16 517 518 519 520, $21 522 523 52a 525 528 527 528 529 530 831 532 533 534 335 536 937 538 333572 18 16 7 D, GineRt and A, GALDEANO 006 = 1M QL = (L-LX)aCH 60 TO (2,-3.4), 1T0E TERR = 1 RETURN CALL APOLE(QL, OK, [Link]) Go To 5 CALL REQUA(OL,OK-PREEL-PIMAG) 60 ToS CALL INTGR(GL,[Link]) PRE=GREEL(L,K) PIMSGIM(L,K) GREEL(L.K)=PREMPREEL - PIMaPIMAG GIM(L.K)=PIMMPREEL + PREwPIMAS CONTINUE, CONTINUE COMBINATION OF THE ELEMENTARY FILTERS WHICH INDEXES ARE 1 00 16 10€=1,NOE IF(PRMT(7, 10E) «GE «200.00.0R-PANT(7,10E)«LT+100.00) GO TO 16 PARI = PRMT(2, 10} PAMT(3, 102) PAMT(4, 106) ‘ABS (INT(SNGL(PAR3 +005) ) ABS(INT(SNGL(PANT(7,10E))+045)) ITM=1TOExO.01 1T0E=1TOE-100 [Link],1) GO TO 17 00 18 IS=1-KY $S=( 15-14 xCN DO 15 IR=Lx.M AR=( TR-LX PCH GO TO (8-9/10-11-12)-1T0E TERR=2 RETURN PAEEL=GPROL(AR,SS) 60 TO 14 PREEL=GOERI(RR,SS) co To 14 PREEL=RESTEIAR,SS) co TO 14 PREEL=GINV(RR,SS) 60 TO 14 PREEL=AMINV(AR, SS) GREELCIR, 1S )=PREELmGREEL( IRIS) GIMCIR, IS)=PREELxGIM( IR, 1S) IFCIRSEQ«LX) GO TO 15 GREEL(LX+LX-IR, 1S )=PREELMGREEL(LX+LX-1R- 1S) GIM(LXsLX- IR, IS) =PREELwGIM(LX+LX- IR, 15) CONTINUE CONTINUE, TeRR=0 RETURN TERR=3 RETURN ENO SUBROUTINE TFPOEQ(W,M.N,GREEL-GIM-LMES) THIS SUBROUTINE COMPUTES THE INVERSE FOURIER TRANSFORM OF A FILTER sao 541 saz 543 54a 545 546 547 543 549 550 581 552 553 354 585 556 587 958 359 360 361 562 563 64 585 366 367 sea 569 570 571 572 573 574 575 576 377 578 573 580 381 382 583 ea ses ses 587 588 583 590 591 592 593 9a 595 596 a7 598 599