Changeset 5082 for LMDZ6/branches/Amaury_dev/libf/filtrez
- Timestamp:
- Jul 19, 2024, 5:41:58 PM (13 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/filtrez
- Files:
-
- 4 edited
-
eigen_sort.F (modified) (2 diffs)
-
filtreg.F (modified) (7 diffs)
-
filtreg_mod.F90 (modified) (18 diffs)
-
jacobi.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/filtrez/eigen_sort.F
r1907 r5082 12 12 p=d(i) 13 13 DO j=i+1,n 14 IF(d(j) .ge.p) THEN14 IF(d(j)>=p) THEN 15 15 k=j 16 16 p=d(j) … … 18 18 ENDDO 19 19 20 IF(k .ne.i) THEN20 IF(k/=i) THEN 21 21 d(k)=d(i) 22 22 d(i)=p -
LMDZ6/branches/Amaury_dev/libf/filtrez/filtreg.F
r4593 r5082 83 83 ENDIF 84 84 85 IF(ifiltre .EQ.1.or.ifiltre.EQ.-1)85 IF(ifiltre==1.or.ifiltre==-1) 86 86 & STOP'Pas de transformee simple dans cette version' 87 87 88 IF( iter .EQ.2 ) THEN88 IF( iter== 2 ) THEN 89 89 PRINT *,' Pas d iteration du filtre dans cette version !' 90 90 & , ' Utiliser old_filtreg et repasser !' … … 92 92 ENDIF 93 93 94 IF( ifiltre .EQ.-2 .AND..NOT.griscal ) THEN94 IF( ifiltre== -2 .AND..NOT.griscal ) THEN 95 95 PRINT *,' Cette routine ne calcule le filtre inverse que ' 96 96 & , ' sur la grille des scalaires !' … … 98 98 ENDIF 99 99 100 IF( ifiltre .NE.2 .AND.ifiltre.NE.- 2 ) THEN100 IF( ifiltre/=2 .AND.ifiltre/= - 2 ) THEN 101 101 PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2' 102 102 & , ' corriger et repasser !' … … 113 113 ELSE 114 114 115 IF( iaire .EQ.1 ) THEN115 IF( iaire==1 ) THEN 116 116 sdd1_type = type_sddv 117 117 sdd2_type = type_unsddv … … 135 135 END IF 136 136 ELSE 137 IF( nlat .NE.jjm ) THEN137 IF( nlat/=jjm ) THEN 138 138 PRINT 2222 139 139 STOP 140 140 ELSE 141 141 142 IF( iaire .EQ.1 ) THEN142 IF( iaire==1 ) THEN 143 143 sdd1_type = type_sddu 144 144 sdd2_type = type_unsddu … … 165 165 DO hemisph = 1, 2 166 166 167 IF ( hemisph .EQ.1 ) THEN167 IF ( hemisph==1 ) THEN 168 168 jdfil = jdfil1 169 169 jffil = jffil1 … … 279 279 ENDIF 280 280 281 IF( ifiltre .EQ.2 ) THEN281 IF( ifiltre== 2 ) THEN 282 282 283 283 DO l = 1, nbniv -
LMDZ6/branches/Amaury_dev/libf/filtrez/filtreg_mod.F90
r4519 r5082 129 129 ! if maxlatfilter >0, prescribe the colat0 value from the .def files 130 130 131 IF (maxlatfilter .LT.0.) THEN131 IF (maxlatfilter < 0.) THEN 132 132 133 133 colat0 = MIN( 0.5, dymin/dxmin ) … … 152 152 50 FORMAT(/15x,' Inifilr colat0 alphax ',2e16.7) 153 153 ! 154 IF(alphax .EQ.1. ) THEN154 IF(alphax==1. ) THEN 155 155 PRINT *,' Inifilr alphax doit etre < a 1. Corriger ' 156 156 STOP … … 195 195 DO j = 2, jjm/2+1 196 196 cof = COS( rlatu(j) )/ colat0 197 IF ( cof .LT.1. ) THEN198 IF( rlamda(imx) * COS(rlatu(j) ) .LT.1. ) THEN197 IF ( cof < 1. ) THEN 198 IF( rlamda(imx) * COS(rlatu(j) )<1. ) THEN 199 199 jfiltnu= j 200 200 ENDIF … … 202 202 203 203 cof = COS( rlatu(jjp1-j+1) )/ colat0 204 IF ( cof .LT.1. ) THEN205 IF( rlamda(imx) * COS(rlatu(jjp1-j+1) ) .LT.1. ) THEN204 IF ( cof < 1. ) THEN 205 IF( rlamda(imx) * COS(rlatu(jjp1-j+1) )<1. ) THEN 206 206 jfiltsu= jjp1-j+1 207 207 ENDIF … … 211 211 DO j = 1, jjm/2 212 212 cof = COS( rlatv(j) )/ colat0 213 IF ( cof .LT.1. ) THEN214 IF( rlamda(imx) * COS(rlatv(j) ) .LT.1. ) THEN213 IF ( cof < 1. ) THEN 214 IF( rlamda(imx) * COS(rlatv(j) )<1. ) THEN 215 215 jfiltnv= j 216 216 ENDIF … … 218 218 219 219 cof = COS( rlatv(jjm-j+1) )/ colat0 220 IF ( cof .LT.1. ) THEN221 IF( rlamda(imx) * COS(rlatv(jjm-j+1) ) .LT.1. ) THEN220 IF ( cof < 1. ) THEN 221 IF( rlamda(imx) * COS(rlatv(jjm-j+1) )<1. ) THEN 222 222 jfiltsv= jjm-j+1 223 223 ENDIF … … 226 226 ! 227 227 228 IF( jfiltnu .GT.jjm/2 +1 ) THEN228 IF( jfiltnu> jjm/2 +1 ) THEN 229 229 PRINT *,' jfiltnu en dehors des valeurs acceptables ' ,jfiltnu 230 230 STOP 231 231 ENDIF 232 232 233 IF( jfiltsu .GT.jjm +1 ) THEN233 IF( jfiltsu> jjm +1 ) THEN 234 234 PRINT *,' jfiltsu en dehors des valeurs acceptables ' ,jfiltsu 235 235 STOP 236 236 ENDIF 237 237 238 IF( jfiltnv .GT.jjm/2 ) THEN238 IF( jfiltnv> jjm/2 ) THEN 239 239 PRINT *,' jfiltnv en dehors des valeurs acceptables ' ,jfiltnv 240 240 STOP 241 241 ENDIF 242 242 243 IF( jfiltsv .GT.jjm ) THEN243 IF( jfiltsv> jjm ) THEN 244 244 PRINT *,' jfiltsv en dehors des valeurs acceptables ' ,jfiltsv 245 245 STOP … … 273 273 DO k = 2,modemax 274 274 cof = rlamda(k) * COS( rlatu(j) ) 275 IF ( cof .LT.1. ) GOTO 82275 IF ( cof < 1. ) GOTO 82 276 276 ENDDO 277 277 GOTO 84 … … 292 292 DO k = 2,modemax 293 293 cof = rlamda(k) * COS( rlatv(j) ) 294 IF ( cof .LT.1. ) GOTO 87294 IF ( cof < 1. ) GOTO 87 295 295 ENDDO 296 296 GOTO 89 … … 309 309 DO k = 2,modemax 310 310 cof = rlamda(k) * COS( rlatu(j) ) 311 IF ( cof .LT.1. ) GOTO 92311 IF ( cof < 1. ) GOTO 92 312 312 ENDDO 313 313 GOTO 94 … … 326 326 DO k = 2,modemax 327 327 cof = rlamda(k) * COS( rlatv(j) ) 328 IF ( cof .LT.1. ) GOTO 97328 IF ( cof < 1. ) GOTO 97 329 329 ENDDO 330 330 GOTO 99 … … 341 341 ! 342 342 343 IF(jfiltnv .GE.jjm/2 .OR. jfiltnu.GE.jjm/2)THEN343 IF(jfiltnv>=jjm/2 .OR. jfiltnu>=jjm/2)THEN 344 344 ! Ehouarn: and what are these for??? Trying to handle a limit case 345 345 ! where filters extend to and meet at the equator? 346 IF(jfiltnv .EQ.jfiltsv)jfiltsv=1+jfiltnv347 IF(jfiltnu .EQ.jfiltsu)jfiltsu=1+jfiltnu346 IF(jfiltnv==jfiltsv)jfiltsv=1+jfiltnv 347 IF(jfiltnu==jfiltsu)jfiltsu=1+jfiltnu 348 348 349 349 PRINT *,'jfiltnv jfiltsv jfiltnu jfiltsu' , & … … 367 367 DO i=1,iim 368 368 coff = coefilu(i,j) 369 IF( i .LT.modfrstu(j) ) coff = 0.369 IF( i<modfrstu(j) ) coff = 0. 370 370 DO k=1,iim 371 371 eignft(i,k) = eignfnv(k,i) * coff … … 397 397 DO i=1,iim 398 398 coff = coefilu(i,j) 399 IF( i .LT.modfrstu(j) ) coff = 0.399 IF( i<modfrstu(j) ) coff = 0. 400 400 DO k=1,iim 401 401 eignft(i,k) = eignfnv(k,i) * coff … … 434 434 DO i = 1, iim 435 435 coff = coefilv(i,j) 436 IF( i .LT.modfrstv(j) ) coff = 0.436 IF( i<modfrstv(j) ) coff = 0. 437 437 DO k = 1, iim 438 438 eignft(i,k) = eignfnu(k,i) * coff … … 464 464 DO i = 1, iim 465 465 coff = coefilv(i,j) 466 IF( i .LT.modfrstv(j) ) coff = 0.466 IF( i<modfrstv(j) ) coff = 0. 467 467 DO k = 1, iim 468 468 eignft(i,k) = eignfnu(k,i) * coff … … 501 501 DO i = 1,iim 502 502 coff = coefilu(i,j)/ ( 1. + coefilu(i,j) ) 503 IF( i .LT.modfrstu(j) ) coff = 0.503 IF( i<modfrstu(j) ) coff = 0. 504 504 DO k=1,iim 505 505 eignft(i,k) = eignfnv(k,i) * coff … … 531 531 DO i = 1,iim 532 532 coff = coefilu(i,j) / ( 1. + coefilu(i,j) ) 533 IF( i .LT.modfrstu(j) ) coff = 0.533 IF( i<modfrstu(j) ) coff = 0. 534 534 DO k=1,iim 535 535 eignft(i,k) = eignfnv(k,i) * coff -
LMDZ6/branches/Amaury_dev/libf/filtrez/jacobi.F90
r1907 r5082 38 38 ENDDO 39 39 ENDDO 40 IF(SM .EQ.0.)RETURN41 IF(I .LT.4)THEN40 IF(SM==0.)RETURN 41 IF(I<4)THEN 42 42 TRESH=0.2*SM/N**2 43 43 ELSE … … 47 47 DO IQ=IP+1,N 48 48 G=100.*ABS(A(IP,IQ)) 49 IF((I .GT.4).AND.(ABS(D(IP))+G.EQ.ABS(D(IP))) &50 .AND.(ABS(D(IQ))+G .EQ.ABS(D(IQ))))THEN49 IF((I>4).AND.(ABS(D(IP))+G==ABS(D(IP))) & 50 .AND.(ABS(D(IQ))+G==ABS(D(IQ))))THEN 51 51 A(IP,IQ)=0. 52 ELSE IF(ABS(A(IP,IQ)) .GT.TRESH)THEN52 ELSE IF(ABS(A(IP,IQ))>TRESH)THEN 53 53 H=D(IQ)-D(IP) 54 IF(ABS(H)+G .EQ.ABS(H))THEN54 IF(ABS(H)+G==ABS(H))THEN 55 55 T=A(IP,IQ)/H 56 56 ELSE 57 57 THETA=0.5*H/A(IP,IQ) 58 58 T=1./(ABS(THETA)+SQRT(1.+THETA**2)) 59 IF(THETA .LT.0.)T=-T59 IF(THETA<0.)T=-T 60 60 ENDIF 61 61 C=1./SQRT(1+T**2)
Note: See TracChangeset
for help on using the changeset viewer.
