Changeset 5082 for LMDZ6/branches/Amaury_dev/libf/dyn3d
- Timestamp:
- Jul 19, 2024, 5:41:58 PM (2 months ago)
- Location:
- LMDZ6/branches/Amaury_dev/libf/dyn3d
- Files:
-
- 19 edited
-
abort_gcm.F (modified) (1 diff)
-
advtrac.F90 (modified) (1 diff)
-
bilan_dyn.F (modified) (12 diffs)
-
caladvtrac.F (modified) (3 diffs)
-
caldyn.F (modified) (1 diff)
-
conf_gcm.F90 (modified) (11 diffs)
-
fluxstokenc.F (modified) (3 diffs)
-
friction.F (modified) (3 diffs)
-
gcm.F90 (modified) (6 diffs)
-
groupe.F (modified) (1 diff)
-
iniinterp_horiz.F (modified) (2 diffs)
-
integrd.F (modified) (2 diffs)
-
qminimum.F (modified) (6 diffs)
-
tetaleveli1j.F (modified) (5 diffs)
-
tetaleveli1j1.F (modified) (5 diffs)
-
top_bound.F (modified) (8 diffs)
-
vlsplt.F (modified) (18 diffs)
-
vlspltqs.F (modified) (11 diffs)
-
wrgrads.F (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/abort_gcm.F
r4619 r5082 47 47 write(lunout,*) 'Stopping in ', modname 48 48 write(lunout,*) 'Reason = ',message 49 if (ierr .eq.0) then49 if (ierr == 0) then 50 50 write(lunout,*) 'Everything is cool' 51 51 stop -
LMDZ6/branches/Amaury_dev/libf/dyn3d/advtrac.F90
r4143 r5082 289 289 END DO 290 290 END DO 291 IF(CFLmaxz .GE.1) WRITE(*,*) 'WARNING vertical','CFLmaxz=', CFLmaxz291 IF(CFLmaxz>=1) WRITE(*,*) 'WARNING vertical','CFLmaxz=', CFLmaxz 292 292 !---------------------------------------------------------------- 293 293 ! Ss-prg interface LMDZ.4->PPM3d (ss-prg de Lin) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/bilan_dyn.F
r4470 r5082 26 26 c==================================================================== 27 27 c 28 c Sous-programme consacre àdes diagnostics dynamiques de base28 c Sous-programme consacre � des diagnostics dynamiques de base 29 29 c 30 30 c … … 89 89 real ww 90 90 91 c variables dynamiques interm édiaires91 c variables dynamiques interm�diaires 92 92 REAL vcont(iip1,jjm,llm),ucont(iip1,jjp1,llm) 93 93 REAL ang(iip1,jjp1,llm),unat(iip1,jjp1,llm) … … 97 97 REAL bern(iip1,jjp1,llm) 98 98 99 c champ contenant les scalaires advect és.99 c champ contenant les scalaires advect�s. 100 100 real Q(iip1,jjp1,llm,nQ) 101 101 102 c champs cumul és102 c champs cumul�s 103 103 real ps_cum(iip1,jjp1) 104 104 real masse_cum(iip1,jjp1,llm) … … 180 180 c ncum est la frequence de stokage en pas de temps 181 181 ncum=dt_cum/dt_app 182 if (abs(ncum*dt_app-dt_cum) .gt.1.e-5*dt_app) then182 if (abs(ncum*dt_app-dt_cum)>1.e-5*dt_app) then 183 183 WRITE(lunout,*) 184 184 . 'Pb : le pas de cumule doit etre multiple du pas' … … 188 188 endif 189 189 190 if (i_sortie .eq.1) then190 if (i_sortie==1) then 191 191 file='dynzon' 192 192 call inigrads(ifile,1 … … 239 239 do iQ=1,nQ 240 240 do itr=1,ntr 241 if(itr .eq.1) then241 if(itr==1) then 242 242 znom(itr,iQ)=nom(iQ) 243 243 znoml(itr,iQ)=nom(iQ) … … 308 308 c ---------------------------- 309 309 310 c énergie cinétique310 c �nergie cin�tique 311 311 ucont(:,:,:)=0 312 312 CALL covcont(llm,ucov,vcov,ucont,vcont) 313 313 CALL enercin(vcov,ucov,vcont,ucont,ecin) 314 314 315 c moment cin étique315 c moment cin�tique 316 316 do l=1,llm 317 317 ang(:,:,l)=ucov(:,:,l)+constang(:,:) … … 332 332 c===================================================================== 333 333 c 334 if(icum .EQ.0) then334 if(icum==0) then 335 335 ps_cum=0. 336 336 masse_cum=0. … … 373 373 enddo 374 374 375 c flux m éridien375 c flux m�ridien 376 376 c ------------- 377 377 do iQ=1,nQ … … 413 413 c PAS DE TEMPS D'ECRITURE 414 414 c===================================================================== 415 if (icum .eq.ncum) then415 if (icum==ncum) then 416 416 c===================================================================== 417 417 … … 440 440 441 441 c===================================================================== 442 c Transport m éridien442 c Transport m�ridien 443 443 c===================================================================== 444 444 … … 534 534 c print*,'4OK' 535 535 c sorties proprement dites 536 if (i_sortie .eq.1) then536 if (i_sortie==1) then 537 537 do iQ=1,nQ 538 538 do itr=1,ntr -
LMDZ6/branches/Amaury_dev/libf/dyn3d/caladvtrac.F
r2597 r5082 51 51 c 52 52 ! Earth-specific stuff for the first 2 tracers (water) 53 if (planet_type .eq."earth") then53 if (planet_type=="earth") then 54 54 C initialisation 55 55 ! CRisi: il faut gérer tous les traceurs si on veut pouvoir faire des … … 70 70 c 71 71 72 IF( iapptrac .EQ.iapp_tracvl ) THEN73 if (planet_type .eq."earth") then72 IF( iapptrac==iapp_tracvl ) THEN 73 if (planet_type=="earth") then 74 74 ! Earth-specific treatment for the first 2 tracers (water) 75 75 c … … 108 108 endif ! of if (planet_type.eq."earth") 109 109 ELSE 110 if (planet_type .eq."earth") then110 if (planet_type=="earth") then 111 111 ! Earth-specific treatment for the first 2 tracers (water) 112 112 dq(:,:,1:nqtot)=0. -
LMDZ6/branches/Amaury_dev/libf/dyn3d/caldyn.F
r2600 r5082 124 124 DO l = 1, llm 125 125 DO ij = 1, ip1jm, iip1 126 IF( dv(ij,l) .NE.dv(ij+iim,l) ) THEN126 IF( dv(ij,l)/=dv(ij+iim,l) ) THEN 127 127 ! PRINT *,'!!!ATTENTION!!! probleme de periodicite sur vcov', 128 128 ! , ' dans caldyn' -
LMDZ6/branches/Amaury_dev/libf/dyn3d/conf_gcm.F90
r4996 r5082 419 419 CALL getin('clat',clatt) 420 420 421 IF( ABS(clat - clatt) .GE.0.001 ) THEN421 IF( ABS(clat - clatt)>= 0.001 ) THEN 422 422 write(lunout,*)'conf_gcm: La valeur de clat passee par run.def', & 423 423 ' est differente de celle lue sur le fichier start ' … … 433 433 CALL getin('grossismx',grossismxx) 434 434 435 IF( ABS(grossismx - grossismxx) .GE.0.001 ) THEN435 IF( ABS(grossismx - grossismxx)>= 0.001 ) THEN 436 436 write(lunout,*)'conf_gcm: La valeur de grossismx passee par ', & 437 437 'run.def est differente de celle lue sur le fichier start ' … … 447 447 CALL getin('grossismy',grossismyy) 448 448 449 IF( ABS(grossismy - grossismyy) .GE.0.001 ) THEN449 IF( ABS(grossismy - grossismyy)>= 0.001 ) THEN 450 450 write(lunout,*)'conf_gcm: La valeur de grossismy passee par ', & 451 451 'run.def est differente de celle lue sur le fichier start ' … … 453 453 ENDIF 454 454 455 IF( grossismx .LT.1. ) THEN455 IF( grossismx<1. ) THEN 456 456 write(lunout,*) & 457 457 'conf_gcm: *** ATTENTION !! grossismx < 1 . *** ' … … 461 461 ENDIF 462 462 463 IF( grossismy .LT.1. ) THEN463 IF( grossismy<1. ) THEN 464 464 write(lunout,*) & 465 465 'conf_gcm: *** ATTENTION !! grossismy < 1 . *** ' … … 506 506 507 507 IF( fxyhypb ) THEN 508 IF( ABS(dzoomx - dzoomxx) .GE.0.001 ) THEN508 IF( ABS(dzoomx - dzoomxx)>= 0.001 ) THEN 509 509 write(lunout,*)'conf_gcm: La valeur de dzoomx passee par ', & 510 510 'run.def est differente de celle lue sur le fichier start ' … … 522 522 523 523 IF( fxyhypb ) THEN 524 IF( ABS(dzoomy - dzoomyy) .GE.0.001 ) THEN524 IF( ABS(dzoomy - dzoomyy)>= 0.001 ) THEN 525 525 write(lunout,*)'conf_gcm: La valeur de dzoomy passee par ', & 526 526 'run.def est differente de celle lue sur le fichier start ' … … 537 537 538 538 IF( fxyhypb ) THEN 539 IF( ABS(taux - tauxx) .GE.0.001 ) THEN539 IF( ABS(taux - tauxx)>= 0.001 ) THEN 540 540 write(lunout,*)'conf_gcm: La valeur de taux passee par ', & 541 541 'run.def est differente de celle lue sur le fichier start ' … … 552 552 553 553 IF( fxyhypb ) THEN 554 IF( ABS(tauy - tauyy) .GE.0.001 ) THEN554 IF( ABS(tauy - tauyy)>= 0.001 ) THEN 555 555 write(lunout,*)'conf_gcm: La valeur de tauy passee par ', & 556 556 'run.def est differente de celle lue sur le fichier start ' … … 715 715 CALL getin('grossismy',grossismy) 716 716 717 IF( grossismx .LT.1. ) THEN717 IF( grossismx<1. ) THEN 718 718 write(lunout,*) & 719 719 'conf_gcm: *** ATTENTION !! grossismx < 1 . *** ' … … 723 723 ENDIF 724 724 725 IF( grossismy .LT.1. ) THEN725 IF( grossismy<1. ) THEN 726 726 write(lunout,*) 'conf_gcm: ***ATTENTION !! grossismy < 1 . *** ' 727 727 CALL abort_gcm("conf_gcm","stopped",1) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/fluxstokenc.F
r2601 r5082 79 79 80 80 81 IF(iadvtr .EQ.0) THEN81 IF(iadvtr==0) THEN 82 82 phic(:,:)=0 83 83 tetac(:,:)=0 … … 99 99 100 100 c selection de la masse instantannee des mailles avant le transport. 101 IF(iadvtr .EQ.0) THEN101 IF(iadvtr==0) THEN 102 102 CALL SCOPY(ip1jmp1*llm,masse,1,massem,1) 103 103 ENDIF … … 107 107 108 108 c Test pour savoir si on advecte a ce pas de temps 109 IF ( iadvtr .EQ.istdyn ) THEN109 IF ( iadvtr==istdyn ) THEN 110 110 c normalisation 111 111 DO l=1,llm -
LMDZ6/branches/Amaury_dev/libf/dyn3d/friction.F
r2597 r5082 53 53 ! set friction type 54 54 call getin("friction_type",friction_type) 55 if ((friction_type .lt.0).or.(friction_type.gt.1)) then55 if ((friction_type<0).or.(friction_type>1)) then 56 56 abort_message="wrong friction type" 57 57 write(lunout,*)'Friction: wrong friction type',friction_type … … 61 61 ENDIF 62 62 63 if (friction_type .eq.0) then63 if (friction_type==0) then 64 64 c calcul des composantes au carre du vent naturel 65 65 do j=1,jjp1 … … 124 124 endif ! of if (friction_type.eq.0) 125 125 126 if (friction_type .eq.1) then126 if (friction_type==1) then 127 127 do l=1,llm 128 128 ucov(:,:,l)=ucov(:,:,l)*(1.-pdt*kfrict(l)) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/gcm.F90
r4619 r5082 216 216 ! we still need to run iniacademic to initialize some 217 217 ! constants & fields, if we run the 'newtonian' or 'SW' cases: 218 if (iflag_phys .ne.1) then218 if (iflag_phys/=1) then 219 219 CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0) 220 220 endif … … 250 250 ! on recalcule eventuellement le pas de temps 251 251 252 IF(MOD(day_step,iperiod) .NE.0) THEN252 IF(MOD(day_step,iperiod)/=0) THEN 253 253 abort_message = & 254 254 'Il faut choisir un nb de pas par jour multiple de iperiod' … … 256 256 ENDIF 257 257 258 IF(MOD(day_step,iphysiq) .NE.0) THEN258 IF(MOD(day_step,iphysiq)/=0) THEN 259 259 abort_message = & 260 260 'Il faut choisir un nb de pas par jour multiple de iphysiq' … … 263 263 264 264 zdtvr = daysec/REAL(day_step) 265 IF(dtvr .NE.zdtvr) THEN265 IF(dtvr/=zdtvr) THEN 266 266 WRITE(lunout,*) & 267 267 'WARNING!!! changement de pas de temps',dtvr,'>',zdtvr … … 290 290 write(lunout,*) & 291 291 'GCM: On reinitialise a la date lue dans gcm.def' 292 ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne.dayref) THEN292 ELSE IF (annee_ref /= anneeref .or. day_ref /= dayref) THEN 293 293 write(lunout,*) & 294 294 'GCM: Attention les dates initiales lues dans le fichier' … … 350 350 351 351 352 if (iflag_phys .eq.1) then352 if (iflag_phys==1) then 353 353 ! these initialisations have already been done (via iniacademic) 354 354 ! if running in SW or Newtonian mode -
LMDZ6/branches/Amaury_dev/libf/dyn3d/groupe.F
r4470 r5082 51 51 if (firstcall) then 52 52 if (groupe_ok) then 53 if(mod(iim,2**ngroup) .ne.0)53 if(mod(iim,2**ngroup)/=0) 54 54 & CALL abort_gcm('groupe','probleme du nombre de point',1) 55 55 endif -
LMDZ6/branches/Amaury_dev/libf/dyn3d/iniinterp_horiz.F
r1907 r5082 116 116 do jj = 1,jmn+1 117 117 do j=1, jmo+1 118 if((cn(jj) .lt.d(j)).and.(dn(jj).gt.c(j)))then118 if((cn(jj)<d(j)).and.(dn(jj)>c(j)))then 119 119 do ii=1,imn + 1 120 120 do i=1, imo +1 121 if ( ((an(ii) .lt.b(i)).and.(bn(ii).gt.a(i)))122 & .or. ((an(ii) .lt.b(i)-2*pi).and.(bn(ii).gt.a(i)-2*pi)123 & .and.(b(i)-2*pi .lt.-pi) )124 & .or. ((an(ii) .lt.b(i)+2*pi).and.(bn(ii).gt.a(i)+2*pi)125 & .and.(a(i)+2*pi .gt.pi) )121 if ( ((an(ii)<b(i)).and.(bn(ii)>a(i))) 122 & .or. ((an(ii)<b(i)-2*pi).and.(bn(ii)>a(i)-2*pi) 123 & .and.(b(i)-2*pi<-pi) ) 124 & .or. ((an(ii)<b(i)+2*pi).and.(bn(ii)>a(i)+2*pi) 125 & .and.(a(i)+2*pi>pi) ) 126 126 & )then 127 127 ktotal = ktotal +1 … … 133 133 dd = min(d(j), dn(jj)) 134 134 cc = cn(jj) 135 if (cc .lt.c(j))cc=c(j)136 if((an(ii) .lt.b(i)-2*pi).and.137 & (bn(ii) .gt.a(i)-2*pi)) then135 if (cc< c(j))cc=c(j) 136 if((an(ii)<b(i)-2*pi).and. 137 & (bn(ii)>a(i)-2*pi)) then 138 138 bb = min(b(i)-2*pi,bn(ii)) 139 139 aa = an(ii) 140 if (aa .lt.a(i)-2*pi) aa=a(i)-2*pi141 else if((an(ii) .lt.b(i)+2*pi).and.142 & (bn(ii) .gt.a(i)+2*pi)) then140 if (aa<a(i)-2*pi) aa=a(i)-2*pi 141 else if((an(ii)<b(i)+2*pi).and. 142 & (bn(ii)>a(i)+2*pi)) then 143 143 bb = min(b(i)+2*pi,bn(ii)) 144 144 aa = an(ii) 145 if (aa .lt.a(i)+2*pi) aa=a(i)+2*pi145 if (aa<a(i)+2*pi) aa=a(i)+2*pi 146 146 else 147 147 bb = min(b(i),bn(ii)) 148 148 aa = an(ii) 149 if (aa .lt.a(i)) aa=a(i)149 if (aa<a(i)) aa=a(i) 150 150 end if 151 151 intersec(ktotal)=(bb-aa)*(sin(dd)-sin(cc)) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/integrd.F
r2603 r5082 98 98 c 99 99 DO ij = 1,ip1jmp1 100 IF( ps(ij) .LT.0. ) THEN100 IF( ps(ij)<0. ) THEN 101 101 write(lunout,*) "integrd: negative surface pressure ",ps(ij) 102 102 write(lunout,*) " at node ij =", ij … … 204 204 c$$$ ENDIF 205 205 206 if (planet_type .eq."earth") then206 if (planet_type=="earth") then 207 207 ! Earth-specific treatment of first 2 tracers (water) 208 208 DO l = 1, llm -
LMDZ6/branches/Amaury_dev/libf/dyn3d/qminimum.F
r5001 r5082 65 65 DO k = 1, llm 66 66 DO i = 1, ip1jmp1 67 if (seuil_liq - q(i,k,iq_liq) .gt.0.d0 ) then67 if (seuil_liq - q(i,k,iq_liq) > 0.d0 ) then 68 68 69 69 if (niso > 0) zx_defau_diag(i,k,2)=AMAX1 … … 82 82 ccc zx_abc = dpres(k) / dpres(k-1) 83 83 DO i = 1, ip1jmp1 84 if ( seuil_vap - q(i,k,iq_vap) .gt.0.d0 ) then84 if ( seuil_vap - q(i,k,iq_vap) > 0.d0 ) then 85 85 86 86 if (niso > 0) zx_defau_diag(i,k,1) … … 104 104 ENDDO 105 105 pompe = SSUM(ip1jmp1,zx_pump,1) 106 IF (imprim .LE.500 .AND. pompe.GT.0.0) THEN106 IF (imprim<=500 .AND. pompe>0.0) THEN 107 107 WRITE(6,'(1x,"ATT!:on pompe de l eau au sol",e15.7)') pompe 108 108 DO i = 1, ip1jmp1 109 IF (zx_pump(i) .GT.0.0) THEN109 IF (zx_pump(i)>0.0) THEN 110 110 imprim = imprim + 1 111 111 PRINT*,'QMINIMUM: en ',i,zx_pump(i) … … 124 124 ! génant 125 125 DO i = 1,ip1jmp1 126 if (zx_pump(i) .gt.0.0) then126 if (zx_pump(i)>0.0) then 127 127 q_follow(i,1,1)=q_follow(i,1,1)+zx_pump(i) 128 128 endif !if (zx_pump(i).gt.0.0) then … … 133 133 do k=2,llm 134 134 DO i = 1,ip1jmp1 135 if (zx_defau_diag(i,k,1) .gt.0.0) then135 if (zx_defau_diag(i,k,1)>0.0) then 136 136 ! on ajoute la vapeur en k 137 137 do ixt=1,ntiso … … 165 165 do k=1,llm 166 166 DO i = 1,ip1jmp1 167 if (zx_defau_diag(i,k,2) .gt.0.0) then167 if (zx_defau_diag(i,k,2)>0.0) then 168 168 169 169 ! on ajoute eau liquide en k en k -
LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j.F
r1907 r5082 57 57 c===================================================================== 58 58 if (lnew) then 59 c on r éinitialise les réindicages et les poids59 c on r�initialise les r�indicages et les poids 60 60 c===================================================================== 61 61 … … 67 67 DO 130 i = 1, ilon 68 68 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT. 69 IF ( ABS(pres-pgcm(i,ilev) ) .GT.69 IF ( ABS(pres-pgcm(i,ilev) ) > 70 70 . ABS(pres-pgcm(i,1)) ) THEN 71 71 lt(i) = ilev ! 2 … … 83 83 ptop = pgcm(i,k+1) 84 84 cIM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN 85 IF (ptop .GE.pres .AND. pbot.LE.pres) THEN85 IF (ptop>=pres .AND. pbot<=pres) THEN 86 86 lt(i) = k+1 87 87 lb(i) = k … … 96 96 c 97 97 c ... Modif . P. Le Van ( 20/01/98) .... 98 c Modif Fr édéric Hourdin (3/01/02)98 c Modif Fr�d�ric Hourdin (3/01/02) 99 99 100 IF(pgcm(i,lb(i)) .EQ.0.OR.101 $ pgcm(i,lt(i)) .EQ.0.) THEN100 IF(pgcm(i,lb(i))==0.OR. 101 $ pgcm(i,lt(i))==0.) THEN 102 102 c 103 103 PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i), … … 128 128 do i = 1, ilon 129 129 cIM if (pgcm(i,1).LT.pres) THEN 130 if (pgcm(i,1) .GT.pres) THEN130 if (pgcm(i,1)>pres) THEN 131 131 c Qpres(i)=1e33 132 132 Qpres(i)=1e+20 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/tetaleveli1j1.F
r1907 r5082 57 57 c===================================================================== 58 58 if (lnew) then 59 c on r éinitialise les réindicages et les poids59 c on r�initialise les r�indicages et les poids 60 60 c===================================================================== 61 61 … … 67 67 DO 130 i = 1, ilon 68 68 cIM IF ( ABS(pres-pgcm(i,ilev) ) .LT. 69 IF ( ABS(pres-pgcm(i,ilev) ) .GT.69 IF ( ABS(pres-pgcm(i,ilev) ) > 70 70 . ABS(pres-pgcm(i,1)) ) THEN 71 71 lt(i) = ilev ! 2 … … 83 83 ptop = pgcm(i,k+1) 84 84 cIM IF (ptop.LE.pres .AND. pbot.GE.pres) THEN 85 IF (ptop .GE.pres .AND. pbot.LE.pres) THEN85 IF (ptop>=pres .AND. pbot<=pres) THEN 86 86 lt(i) = k+1 87 87 lb(i) = k … … 96 96 c 97 97 c ... Modif . P. Le Van ( 20/01/98) .... 98 c Modif Fr édéric Hourdin (3/01/02)98 c Modif Fr�d�ric Hourdin (3/01/02) 99 99 100 IF(pgcm(i,lb(i)) .EQ.0.OR.101 $ pgcm(i,lt(i)) .EQ.0.) THEN100 IF(pgcm(i,lb(i))==0.OR. 101 $ pgcm(i,lt(i))==0.) THEN 102 102 c 103 103 PRINT*,'i,lb,lt,2pgcm,pres',i,lb(i), … … 128 128 do i = 1, ilon 129 129 cIM if (pgcm(i,1).LT.pres) THEN 130 if (pgcm(i,1) .GT.pres) THEN130 if (pgcm(i,1)>pres) THEN 131 131 c Qpres(i)=1e33 132 132 Qpres(i)=1e+20 -
LMDZ6/branches/Amaury_dev/libf/dyn3d/top_bound.F
r2600 r5082 27 27 c ------ 28 28 c 29 c Dissipation lin éaire (ex top_bound de la physique)29 c Dissipation lin�aire (ex top_bound de la physique) 30 30 c 31 31 c======================================================================= … … 80 80 INTEGER j,l 81 81 82 if (iflag_top_bound .eq.0) return82 if (iflag_top_bound==0) return 83 83 84 84 if (first) then 85 if (iflag_top_bound .eq.1) then85 if (iflag_top_bound==1) then 86 86 ! sponge quenching over the topmost 4 atmospheric layers 87 87 lambda(:)=0. … … 90 90 lambda(llm-2)=tau_top_bound/4. 91 91 lambda(llm-3)=tau_top_bound/8. 92 else if (iflag_top_bound .eq.2) then92 else if (iflag_top_bound==2) then 93 93 ! sponge quenching over topmost layers down to pressures which are 94 94 ! higher than 100 times the topmost layer pressure … … 105 105 write(lunout,*)'p (Pa) z(km) tau(s) 1./tau (Hz)' 106 106 do l=1,llm 107 if (rdamp(l) .ne.0.) then107 if (rdamp(l)/=0.) then 108 108 write(lunout,'(6(1pe12.4,1x))') 109 109 & presnivs(l),log(preff/presnivs(l))*scaleheight, … … 117 117 118 118 ! compute zonal average of vcov and u 119 if (mode_top_bound .ge.2) then119 if (mode_top_bound>=2) then 120 120 do l=1,llm 121 121 do j=1,jjm … … 149 149 150 150 ! compute zonal average of potential temperature, if necessary 151 if (mode_top_bound .ge.3) then151 if (mode_top_bound>=3) then 152 152 do l=1,llm 153 153 do j=2,jjm ! excluding poles … … 163 163 endif ! of if (mode_top_bound.ge.3) 164 164 165 if (mode_top_bound .ge.1) then165 if (mode_top_bound>=1) then 166 166 ! Apply sponge quenching on vcov: 167 167 do l=1,llm … … 185 185 endif ! of if (mode_top_bound.ge.1) 186 186 187 if (mode_top_bound .ge.3) then187 if (mode_top_bound>=3) then 188 188 ! Apply sponge quenching on teta: 189 189 do l=1,llm -
LMDZ6/branches/Amaury_dev/libf/dyn3d/vlsplt.F
r4470 r5082 174 174 175 175 176 IF (pente_max .gt.-1.e-5) THEN176 IF (pente_max>-1.e-5) THEN 177 177 c IF (pente_max.gt.10) THEN 178 178 … … 214 214 , cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij)) 215 215 #else 216 IF(dxqu(ij-1)*dxqu(ij) .gt.0) THEN216 IF(dxqu(ij-1)*dxqu(ij)>0) THEN 217 217 dxq(ij,l)=dxqu(ij-1)+dxqu(ij) 218 218 ELSE … … 245 245 zz(ij)=dxqu(ij-1)*dxqu(ij) 246 246 zz(ij)=zz(ij)+zz(ij) 247 IF(zz(ij) .gt.0) THEN247 IF(zz(ij)>0) THEN 248 248 dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij)) 249 249 ELSE … … 297 297 DO ij=iip2,ip1jm-1 298 298 c print*,'masse(',ij,')=',masse(ij,l,iq) 299 IF (u_m(ij,l) .gt.0.) THEN299 IF (u_m(ij,l)>0.) THEN 300 300 zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq) 301 301 u_mq(ij,l)=u_m(ij,l)*(q(ij,l,iq)+0.5*zdum(ij,l)*dxq(ij,l)) … … 314 314 DO l=1,llm 315 315 DO ij=iip2,ip1jm-1 316 IF(zdum(ij,l) .lt.0) THEN316 IF(zdum(ij,l)<0) THEN 317 317 iadvplus(ij,l)=1 318 318 u_mq(ij,l)=0. … … 344 344 ENDDO 345 345 346 IF(n0 .gt.0) THEN346 IF(n0>0) THEN 347 347 if (prt_level > 2) PRINT *, 348 348 $ 'Nombre de points pour lesquels on advect plus que le' … … 350 350 351 351 DO l=1,llm 352 IF(nl(l) .gt.0) THEN352 IF(nl(l)>0) THEN 353 353 iju=0 354 354 c indicage des mailles concernees par le traitement special 355 355 DO ij=iip2,ip1jm 356 IF(iadvplus(ij,l) .eq.1.and.mod(ij,iip1).ne.0) THEN356 IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN 357 357 iju=iju+1 358 358 indu(iju)=ij … … 368 368 zu_m=u_m(ij,l) 369 369 u_mq(ij,l)=0. 370 IF(zu_m .gt.0.) THEN370 IF(zu_m>0.) THEN 371 371 ijq=ij 372 372 i=ijq-(j-1)*iip1 373 373 c accumulation pour les mailles completements advectees 374 do while(zu_m .gt.masse(ijq,l,iq))374 do while(zu_m>masse(ijq,l,iq)) 375 375 u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq) 376 376 & *masse(ijq,l,iq) … … 387 387 i=ijq-(j-1)*iip1 388 388 c accumulation pour les mailles completements advectees 389 do while(-zu_m .gt.masse(ijq,l,iq))389 do while(-zu_m>masse(ijq,l,iq)) 390 390 u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq) 391 391 & *masse(ijq,l,iq) … … 426 426 !Mvals: veiller a ce qu'on n'ait pas de denominateur nul 427 427 masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 428 if (q(ij,l,iq) .gt.min_qParent) then428 if (q(ij,l,iq)>min_qParent) then 429 429 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 430 430 else … … 624 624 fs=1. 625 625 DO ij=1,iim 626 IF(pente_max*adyqv(ij) .lt.abs(dyq(ij,l))) THEN626 IF(pente_max*adyqv(ij)<abs(dyq(ij,l))) THEN 627 627 fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn) 628 628 ENDIF 629 IF(pente_max*adyqv(ij+ip1jm-iip1) .lt.abs(dyq(ij+ip1jm,l))) THEN629 IF(pente_max*adyqv(ij+ip1jm-iip1)<abs(dyq(ij+ip1jm,l))) THEN 630 630 fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs) 631 631 ENDIF … … 711 711 712 712 DO ij=iip2,ip1jm 713 IF(dyqv(ij)*dyqv(ij-iip1) .gt.0.) THEN713 IF(dyqv(ij)*dyqv(ij-iip1)>0.) THEN 714 714 dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l)) 715 715 ELSE … … 723 723 DO l=1,llm 724 724 DO ij=1,ip1jm 725 IF(masse_adv_v(ij,l) .gt.0) THEN725 IF(masse_adv_v(ij,l)>0) THEN 726 726 qbyv(ij,l)=q(ij+iip1,l,iq)+dyq(ij+iip1,l)* 727 727 , 0.5*(1.-masse_adv_v(ij,l) … … 750 750 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 751 751 masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 752 if (q(ij,l,iq) .gt.min_qParent) then752 if (q(ij,l,iq)>min_qParent) then 753 753 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 754 754 else … … 917 917 , cvmgp(dzqw(ij,l)+dzqw(ij,l+1),0.,dzqw(ij,l)*dzqw(ij,l+1)) 918 918 #else 919 IF(dzqw(ij,l)*dzqw(ij,l+1) .gt.0.) THEN919 IF(dzqw(ij,l)*dzqw(ij,l+1)>0.) THEN 920 920 dzq(ij,l)=0.5*(dzqw(ij,l)+dzqw(ij,l+1)) 921 921 ELSE … … 948 948 DO l = 1,llm-1 949 949 do ij = 1,ip1jmp1 950 IF(w(ij,l+1) .gt.0.) THEN950 IF(w(ij,l+1)>0.) THEN 951 951 sigw=w(ij,l+1)/masse(ij,l+1,iq) 952 952 wq(ij,l+1)=w(ij,l+1)*(q(ij,l+1,iq) … … 975 975 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 976 976 masseq(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 977 if (q(ij,l,iq) .gt.min_qParent) then977 if (q(ij,l,iq)>min_qParent) then 978 978 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 979 979 else … … 1074 1074 zqmax=zq(ijlmax,lmax) 1075 1075 1076 if(zqmin .lt.qmin)1076 if(zqmin<qmin) 1077 1077 c s write(*,9999) comment, 1078 1078 s write(*,*) comment, 1079 1079 s imin,jmin,lmin,zqmin,zzq(imin,jmin,lmin) 1080 if(zqmax .gt.qmax)1080 if(zqmax>qmax) 1081 1081 c s write(*,9999) comment, 1082 1082 s write(*,*) comment, -
LMDZ6/branches/Amaury_dev/libf/dyn3d/vlspltqs.F
r4996 r5082 242 242 243 243 244 IF (pente_max .gt.-1.e-5) THEN244 IF (pente_max>-1.e-5) THEN 245 245 c IF (pente_max.gt.10) THEN 246 246 … … 282 282 , cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij)) 283 283 #else 284 IF(dxqu(ij-1)*dxqu(ij) .gt.0) THEN284 IF(dxqu(ij-1)*dxqu(ij)>0) THEN 285 285 dxq(ij,l)=dxqu(ij-1)+dxqu(ij) 286 286 ELSE … … 312 312 zz(ij)=dxqu(ij-1)*dxqu(ij) 313 313 zz(ij)=zz(ij)+zz(ij) 314 IF(zz(ij) .gt.0) THEN314 IF(zz(ij)>0) THEN 315 315 dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij)) 316 316 ELSE … … 362 362 DO l=1,llm 363 363 DO ij=iip2,ip1jm-1 364 IF (u_m(ij,l) .gt.0.) THEN364 IF (u_m(ij,l)>0.) THEN 365 365 zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq) 366 366 u_mq(ij,l)=u_m(ij,l)* … … 380 380 DO l=1,llm 381 381 DO ij=iip2,ip1jm-1 382 IF(zdum(ij,l) .lt.0) THEN382 IF(zdum(ij,l)<0) THEN 383 383 iadvplus(ij,l)=1 384 384 u_mq(ij,l)=0. … … 411 411 ENDDO 412 412 413 IF(n0 .gt.0) THEN413 IF(n0>0) THEN 414 414 ccc PRINT*,'Nombre de points pour lesquels on advect plus que le' 415 415 ccc & ,'contenu de la maille : ',n0 416 416 417 417 DO l=1,llm 418 IF(nl(l) .gt.0) THEN418 IF(nl(l)>0) THEN 419 419 iju=0 420 420 c indicage des mailles concernees par le traitement special 421 421 DO ij=iip2,ip1jm 422 IF(iadvplus(ij,l) .eq.1.and.mod(ij,iip1).ne.0) THEN422 IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN 423 423 iju=iju+1 424 424 indu(iju)=ij … … 434 434 zu_m=u_m(ij,l) 435 435 u_mq(ij,l)=0. 436 IF(zu_m .gt.0.) THEN436 IF(zu_m>0.) THEN 437 437 ijq=ij 438 438 i=ijq-(j-1)*iip1 439 439 c accumulation pour les mailles completements advectees 440 do while(zu_m .gt.masse(ijq,l,iq))440 do while(zu_m>masse(ijq,l,iq)) 441 441 u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq) 442 442 & *masse(ijq,l,iq) … … 453 453 i=ijq-(j-1)*iip1 454 454 c accumulation pour les mailles completements advectees 455 do while(-zu_m .gt.masse(ijq,l,iq))455 do while(-zu_m>masse(ijq,l,iq)) 456 456 u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq) 457 457 & *masse(ijq,l,iq) … … 681 681 fs=1. 682 682 DO ij=1,iim 683 IF(pente_max*adyqv(ij) .lt.abs(dyq(ij,l))) THEN683 IF(pente_max*adyqv(ij)<abs(dyq(ij,l))) THEN 684 684 fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn) 685 685 ENDIF 686 IF(pente_max*adyqv(ij+ip1jm-iip1) .lt.abs(dyq(ij+ip1jm,l))) THEN686 IF(pente_max*adyqv(ij+ip1jm-iip1)<abs(dyq(ij+ip1jm,l))) THEN 687 687 fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs) 688 688 ENDIF … … 763 763 764 764 DO ij=iip2,ip1jm 765 IF(dyqv(ij)*dyqv(ij-iip1) .gt.0.) THEN765 IF(dyqv(ij)*dyqv(ij-iip1)>0.) THEN 766 766 dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l)) 767 767 ELSE … … 774 774 DO l=1,llm 775 775 DO ij=1,ip1jm 776 IF( masse_adv_v(ij,l) .GT.0. ) THEN776 IF( masse_adv_v(ij,l)>0. ) THEN 777 777 qbyv(ij,l)= MIN( qsat(ij+iip1,l), q(ij+iip1,l,iq ) + 778 778 , dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l) -
LMDZ6/branches/Amaury_dev/libf/dyn3d/wrgrads.F
r4470 r5082 46 46 47 47 if(firsttime(if)) then 48 if(name .eq.var(1,if)) then48 if(name==var(1,if)) then 49 49 firsttime(if)=.false. 50 50 ivar(if)=1 … … 68 68 else 69 69 ivar(if)=mod(ivar(if),nvar(if))+1 70 if (ivar(if) .eq.nvar(if)) then70 if (ivar(if)==nvar(if)) then 71 71 writectl=.true. 72 72 itime(if)=itime(if)+1 73 73 endif 74 74 75 if(var(ivar(if),if) .ne.name) then75 if(var(ivar(if),if)/=name) then 76 76 print*,'Il faut stoker la meme succession de champs a chaque' 77 77 print*,'pas de temps'
Note: See TracChangeset
for help on using the changeset viewer.
