Changeset 5081 for LMDZ6/branches/Amaury_dev
- Timestamp:
- Jul 19, 2024, 4:15:44 PM (6 months ago)
- Location:
- LMDZ6/branches/Amaury_dev
- Files:
-
- 41 edited
-
libf/dyn3d/leapfrog.F (modified) (11 diffs)
-
libf/dyn3d_common/limy.F (modified) (3 diffs)
-
libf/dyn3d_common/massbarxy.F90 (modified) (1 diff)
-
libf/dyn3dmem/guide_loc_mod.F90 (modified) (9 diffs)
-
libf/dyn3dmem/massbarxy_loc.F90 (modified) (1 diff)
-
libf/dyn3dmem/vlspltqs_loc.F (modified) (16 diffs)
-
libf/misc/cray.F (modified) (2 diffs)
-
libf/phy_common/mod_phys_lmdz_mpi_transfert.F90 (modified) (1 diff)
-
libf/phylmd/StratAer/cond_evap_tstep_mod.F90 (modified) (2 diffs)
-
libf/phylmd/YOECUMF.h (modified) (1 diff)
-
libf/phylmd/aaam_bud.F90 (modified) (1 diff)
-
libf/phylmd/acama_gwd_rando_m.F90 (modified) (1 diff)
-
libf/phylmd/add_phys_tend_mod.F90 (modified) (14 diffs)
-
libf/phylmd/add_wake_tend.F90 (modified) (3 diffs)
-
libf/phylmd/alpale.h (modified) (1 diff)
-
libf/phylmd/alpale_wk.F90 (modified) (1 diff)
-
libf/phylmd/clesphys.h (modified) (2 diffs)
-
libf/phylmd/climb_hq_mod.F90 (modified) (5 diffs)
-
libf/phylmd/conf_phys_m.F90 (modified) (7 diffs)
-
libf/phylmd/cosp/m_mrgrnk.F90 (modified) (2 diffs)
-
libf/phylmd/cosp/optics_lib.F90 (modified) (9 diffs)
-
libf/phylmd/cosp2/mrgrnk.F90 (modified) (3 diffs)
-
libf/phylmd/cospv2/cosp_optics.F90 (modified) (6 diffs)
-
libf/phylmd/cospv2/mrgrnk.F90 (modified) (3 diffs)
-
libf/phylmd/cospv2/optics_lib.F90 (modified) (7 diffs)
-
libf/phylmd/cospv2/quickbeam.F90 (modified) (14 diffs)
-
libf/phylmd/cospv2/quickbeam_optics.F90 (modified) (7 diffs)
-
libf/phylmd/cospv2/scops.F90 (modified) (11 diffs)
-
libf/phylmd/cv30param.h (modified) (1 diff)
-
libf/phylmd/cv3param.h (modified) (1 diff)
-
libf/phylmd/cva_driver.F90 (modified) (3 diffs)
-
libf/phylmd/cvparam.h (modified) (1 diff)
-
libf/phylmd/flux_arp.h (modified) (1 diff)
-
libf/phylmd/lmdz_ratqs_ini.F90 (modified) (2 diffs)
-
libf/phylmd/lmdz_thermcell_ini.F90 (modified) (1 diff)
-
libf/phylmd/rrtm/rrtm_taumol1.F90 (modified) (1 diff)
-
libf/phylmd/tlift.F90 (modified) (1 diff)
-
libf/phylmd/yamada_ini_mod.F90 (modified) (1 diff)
-
libf/phylmdiso/add_phys_tend_mod.F90 (modified) (14 diffs)
-
libf/phylmdiso/physiq_mod.F90 (modified) (15 diffs)
-
tools/netcdf95/nf95_abort.f90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F
r4143 r5081 301 301 IF( purmats ) THEN 302 302 ! Purely Matsuno time stepping 303 IF( MOD(itau,iconser) .EQ.0.AND. forward ) conser = .TRUE.304 IF( MOD(itau,dissip_period ) .EQ.0.AND..NOT.forward )303 IF( MOD(itau,iconser) ==0.AND. forward ) conser = .TRUE. 304 IF( MOD(itau,dissip_period )==0.AND..NOT.forward ) 305 305 s apdiss = .TRUE. 306 IF( MOD(itau,iphysiq ) .EQ.0.AND..NOT.forward306 IF( MOD(itau,iphysiq )==0.AND..NOT.forward 307 307 s .and. physic ) apphys = .TRUE. 308 308 ELSE 309 309 ! Leapfrog/Matsuno time stepping 310 IF( MOD(itau ,iconser) .EQ.0 ) conser = .TRUE.311 IF( MOD(itau+1,dissip_period) .EQ.0 .AND. .NOT. forward )310 IF( MOD(itau ,iconser) == 0 ) conser = .TRUE. 311 IF( MOD(itau+1,dissip_period)==0 .AND. .NOT. forward ) 312 312 s apdiss = .TRUE. 313 IF( MOD(itau+1,iphysiq) .EQ.0.AND.physic ) apphys=.TRUE.313 IF( MOD(itau+1,iphysiq)==0.AND.physic ) apphys=.TRUE. 314 314 END IF 315 315 316 316 ! Ehouarn: for Shallow Water case (ie: 1 vertical layer), 317 317 ! supress dissipation step 318 if (llm .eq.1) then318 if (llm==1) then 319 319 apdiss=.false. 320 320 endif … … 387 387 c 388 388 IF( purmats ) THEN 389 IF( itau .EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.389 IF( itau==itaufin.AND..NOT.forward ) lafin = .TRUE. 390 390 ELSE 391 391 IF( itau+1. EQ. itaufin ) lafin = .TRUE. … … 418 418 & (itau+1)/day_step 419 419 420 IF (planet_type .eq."generic") THEN420 IF (planet_type =="generic") THEN 421 421 ! AS: we make jD_cur to be pday 422 422 jD_cur = int(day_ini + itau/day_step) … … 441 441 442 442 c Diagnostique de conservation de l'energie : initialisation 443 IF (ip_ebil_dyn .ge.1 ) THEN443 IF (ip_ebil_dyn>=1 ) THEN 444 444 ztit='bil dyn' 445 445 ! Ehouarn: be careful, diagedyn is Earth-specific! 446 IF (planet_type .eq."earth") THEN446 IF (planet_type=="earth") THEN 447 447 CALL diagedyn(ztit,2,1,1,dtphys 448 448 & , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) … … 488 488 c 489 489 c Diagnostique de conservation de l'energie : difference 490 IF (ip_ebil_dyn .ge.1 ) THEN490 IF (ip_ebil_dyn>=1 ) THEN 491 491 ztit='bil phys' 492 IF (planet_type .eq."earth") THEN492 IF (planet_type=="earth") THEN 493 493 CALL diagedyn(ztit,2,1,1,dtphys 494 494 & , ucov , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2)) … … 498 498 ENDIF ! of IF( apphys ) 499 499 500 IF(iflag_phys .EQ.2) THEN ! "Newtonian" case500 IF(iflag_phys==2) THEN ! "Newtonian" case 501 501 ! Academic case : Simple friction and Newtonan relaxation 502 502 ! ------------------------------------------------------- … … 508 508 ENDDO ! of DO l=1,llm 509 509 510 if (planet_type .eq."giant") then510 if (planet_type=="giant") then 511 511 ! add an intrinsic heat flux at the base of the atmosphere 512 512 teta(:,1)=teta(:,1)+dtvr*aire(:)*ihf/cpp/masse(:,1) … … 663 663 c ------------------------------------- 664 664 665 IF(MOD(itau,iperiod) .EQ.0 .OR. itau.EQ.itaufin) THEN666 IF(itau .EQ.itaufin) THEN665 IF(MOD(itau,iperiod)==0 .OR. itau==itaufin) THEN 666 IF(itau==itaufin) THEN 667 667 iav=1 668 668 ELSE … … 694 694 c ------------------------------ 695 695 696 IF( MOD(itau,iecri) .EQ.0) THEN696 IF( MOD(itau,iecri)==0) THEN 697 697 ! Ehouarn: output only during LF or Backward Matsuno 698 698 if (leapf.or.(.not.leapf.and.(.not.forward))) then … … 721 721 ENDIF ! of IF(MOD(itau,iecri).EQ.0) 722 722 723 IF(itau .EQ.itaufin) THEN723 IF(itau==itaufin) THEN 724 724 725 725 … … 743 743 c ------------------------------------ 744 744 745 IF( MOD(itau,iperiod) .EQ.0 ) THEN745 IF( MOD(itau,iperiod)==0 ) THEN 746 746 GO TO 1 747 747 ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.F
r2603 r5081 150 150 c enddo 151 151 152 if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1)) .le.0.)152 if(dyqv(ismin(iim,dyqv,1))*dyqv(ismax(iim,dyqv,1))<=0.) 153 153 & then 154 154 do ij=1,iip1 … … 162 162 163 163 if(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* 164 & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1) .le.0.)164 & dyqv(ismin(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)<=0.) 165 165 &then 166 166 do ij=ip1jm+1,ip1jmp1 … … 175 175 c calcul des pentes limitees 176 176 177 do ij=1,ip1jmp1 178 if(dyqv(ij)*dyqv(ij-iip1) .gt.0.) then177 do ij=1,ip1jmp1 ! cf below: should it be ip1jm instead ? 178 if(dyqv(ij)*dyqv(ij-iip1)>0.) then ! /!\ causes Warning: iteration 1056 invokes undefined behavior [-Waggressive-loop-optimizations] in 32x32x39 179 179 dyq(ij)=sign(min(abs(dyq(ij)),dyqmax(ij)),dyq(ij)) 180 180 else -
LMDZ6/branches/Amaury_dev/libf/dyn3d_common/massbarxy.F90
r2597 r5081 21 21 DO ij=1,ip1jm-1 22 22 massebxy(ij,l)=masse(ij ,l)*alpha2(ij ) + & 23 +masse(ij+1 ,l)*alpha3(ij+1 ) + &24 +masse(ij+iip1,l)*alpha1(ij+iip1) + &25 +masse(ij+iip2,l)*alpha4(ij+iip2)23 masse(ij+1 ,l)*alpha3(ij+1 ) + & 24 masse(ij+iip1,l)*alpha1(ij+iip1) + & 25 masse(ij+iip2,l)*alpha4(ij+iip2) 26 26 END DO 27 27 DO ij=iip1,ip1jm,iip1; massebxy(ij,l)=massebxy(ij-iim,l); END DO -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/guide_loc_mod.F90
r5072 r5081 1598 1598 if (first) then 1599 1599 ncidpl=-99 1600 write(*,*) ,trim(modname)//': opening nudging files '1600 write(*,*) trim(modname)//': opening nudging files ' 1601 1601 ! Ap et Bp si Niveaux de pression hybrides 1602 1602 if (guide_plevs==1) then 1603 write(*,*) ,trim(modname)//' Reading nudging on model levels'1603 write(*,*) trim(modname)//' Reading nudging on model levels' 1604 1604 rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl) 1605 1605 IF (rcode/=NF_NOERR) THEN … … 1617 1617 CALL abort_gcm(modname,abort_message,1) 1618 1618 ENDIF 1619 write(*,*) ,trim(modname)//' ncidpl,varidap',ncidpl,varidap1619 write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap 1620 1620 endif 1621 1621 … … 1632 1632 CALL abort_gcm(modname,abort_message,1) 1633 1633 ENDIF 1634 write(*,*) ,trim(modname)//' ncidp,varidp',ncidp,varidp1634 write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp 1635 1635 if (ncidpl==-99) ncidpl=ncidp 1636 1636 endif … … 1648 1648 CALL abort_gcm(modname,abort_message,1) 1649 1649 ENDIF 1650 write(*,*) ,trim(modname)//' ncidu,varidu',ncidu,varidu1650 write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu 1651 1651 if (ncidpl==-99) ncidpl=ncidu 1652 1652 … … 1680 1680 CALL abort_gcm(modname,abort_message,1) 1681 1681 ENDIF 1682 write(*,*) ,trim(modname)//' ncidv,varidv',ncidv,varidv1682 write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv 1683 1683 if (ncidpl==-99) ncidpl=ncidv 1684 1684 … … 1713 1713 CALL abort_gcm(modname,abort_message,1) 1714 1714 ENDIF 1715 write(*,*) ,trim(modname)//' ncidT,varidT',ncidt,varidt1715 write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt 1716 1716 if (ncidpl==-99) ncidpl=ncidt 1717 1717 … … 1744 1744 CALL abort_gcm(modname,abort_message,1) 1745 1745 ENDIF 1746 write(*,*) ,trim(modname)//' ncidQ,varidQ',ncidQ,varidQ1746 write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ 1747 1747 if (ncidpl==-99) ncidpl=ncidQ 1748 1748 … … 1776 1776 CALL abort_gcm(modname,abort_message,1) 1777 1777 ENDIF 1778 write(*,*) ,trim(modname)//' ncidps,varidps',ncidps,varidps1778 write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps 1779 1779 endif 1780 1780 ! Coordonnee verticale … … 1782 1782 rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl) 1783 1783 IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl) 1784 write(*,*) ,trim(modname)//' ncidpl,varidpl',ncidpl,varidpl1784 write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl 1785 1785 endif 1786 1786 ! Coefs ap, bp pour calcul de la pression aux differents niveaux -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massbarxy_loc.F90
r2597 r5081 27 27 DO ij=ijb,ije-1 28 28 massebxy(ij,l)=masse(ij ,l)*alpha2(ij ) + & 29 +masse(ij+1 ,l)*alpha3(ij+1 ) + &30 +masse(ij+iip1,l)*alpha1(ij+iip1) + &31 +masse(ij+iip2,l)*alpha4(ij+iip2)29 masse(ij+1 ,l)*alpha3(ij+1 ) + & 30 masse(ij+iip1,l)*alpha1(ij+iip1) + & 31 masse(ij+iip2,l)*alpha4(ij+iip2) 32 32 END DO 33 33 DO ij=ijb+iip1-1,ije+iip1-1,iip1; massebxy(ij,l)=massebxy(ij-iim,l); END DO -
LMDZ6/branches/Amaury_dev/libf/dyn3dmem/vlspltqs_loc.F
r4469 r5081 62 62 if (pole_sud.and.ije==ip1jmp1) ije=ije-iip1 63 63 64 IF (pente_max .gt.-1.e-5) THEN64 IF (pente_max>-1.e-5) THEN 65 65 c IF (pente_max.gt.10) THEN 66 66 … … 104 104 , cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij)) 105 105 #else 106 IF(dxqu(ij-1)*dxqu(ij) .gt.0) THEN106 IF(dxqu(ij-1)*dxqu(ij)>0) THEN 107 107 dxq(ij,l)=dxqu(ij-1)+dxqu(ij) 108 108 ELSE … … 135 135 zz(ij)=dxqu(ij-1)*dxqu(ij) 136 136 zz(ij)=zz(ij)+zz(ij) 137 IF(zz(ij) .gt.0) THEN137 IF(zz(ij)>0) THEN 138 138 dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij)) 139 139 ELSE … … 205 205 DO l=1,llm 206 206 DO ij=ijb,ije-1 207 IF (u_m(ij,l) .gt.0.) THEN207 IF (u_m(ij,l)>0.) THEN 208 208 zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq) 209 209 u_mq(ij,l)=u_m(ij,l)* … … 225 225 DO l=1,llm 226 226 DO ij=ijb,ije-1 227 IF(zdum(ij,l) .lt.0) THEN227 IF(zdum(ij,l)<0) THEN 228 228 iadvplus(ij,l)=1 229 229 u_mq(ij,l)=0. … … 269 269 c$OMP DO SCHEDULE(STATIC,OMP_CHUNK) 270 270 DO l=1,llm 271 IF(nl(l) .gt.0) THEN271 IF(nl(l)>0) THEN 272 272 iju=0 273 273 c indicage des mailles concernees par le traitement special 274 274 DO ij=ijb,ije 275 IF(iadvplus(ij,l) .eq.1.and.mod(ij,iip1).ne.0) THEN275 IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN 276 276 iju=iju+1 277 277 indu(iju)=ij … … 287 287 zu_m=u_m(ij,l) 288 288 u_mq(ij,l)=0. 289 IF(zu_m .gt.0.) THEN289 IF(zu_m>0.) THEN 290 290 ijq=ij 291 291 i=ijq-(j-1)*iip1 292 292 c accumulation pour les mailles completements advectees 293 do while(zu_m .gt.masse(ijq,l,iq))293 do while(zu_m>masse(ijq,l,iq)) 294 294 u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq) 295 295 & *masse(ijq,l,iq) … … 305 305 i=ijq-(j-1)*iip1 306 306 c accumulation pour les mailles completements advectees 307 do while(-zu_m .gt.masse(ijq,l,iq))307 do while(-zu_m>masse(ijq,l,iq)) 308 308 u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq) 309 309 & *masse(ijq,l,iq) … … 345 345 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 346 346 masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),min_qMass) 347 if (q(ij,l,iq) .gt.min_qParent) then ! modif 13 nov 2020347 if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020 348 348 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 349 349 else … … 478 478 ij=3525 479 479 l=3 480 if ((ij .ge.ijb).and.(ij.le.ije)) then480 if ((ij>=ijb).and.(ij<=ije)) then 481 481 !write(*,*) 'vlyqs 480: ij,l,iq,ijb,q(ij,l,:)=', 482 482 ! & ij,l,iq,ijb,q(ij,l,:) … … 576 576 fn=1. 577 577 DO ij=1,iim 578 IF(pente_max*adyqv(ij) .lt.abs(dyq(ij,l))) THEN578 IF(pente_max*adyqv(ij)<abs(dyq(ij,l))) THEN 579 579 fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn) 580 580 ENDIF … … 608 608 fs=1. 609 609 DO ij=1,iim 610 IF(pente_max*adyqv(ij+ip1jm-iip1) .lt.abs(dyq(ij+ip1jm,l))) THEN610 IF(pente_max*adyqv(ij+ip1jm-iip1)<abs(dyq(ij+ip1jm,l))) THEN 611 611 fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs) 612 612 ENDIF … … 694 694 695 695 DO ij=ijb,ije 696 IF(dyqv(ij)*dyqv(ij-iip1) .gt.0.) THEN696 IF(dyqv(ij)*dyqv(ij-iip1)>0.) THEN 697 697 dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l)) 698 698 ELSE … … 712 712 DO l=1,llm 713 713 DO ij=ijb,ije 714 IF( masse_adv_v(ij,l) .GT.0. ) THEN714 IF( masse_adv_v(ij,l)>0. ) THEN 715 715 qbyv(ij,l,iq)= MIN( qsat(ij+iip1,l), q(ij+iip1,l,iq ) + 716 716 , dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l) … … 757 757 !MVals: veiller a ce qu'on n'ait pas de denominateur nul 758 758 !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq) 759 if (q(ij,l,iq) .gt.min_qParent) then ! modif 13 nov 2020759 if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020 760 760 Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq) 761 761 else … … 806 806 IF (pole_sud) THEN 807 807 808 convps = -SSUM(iim,qbyv(ip1jm-iim,l,iq),iq,1)/apols 808 convps = -SSUM(iim,qbyv(ip1jm-iim,l,iq),iq,1)/apols ! /!\ called with 4 args ??? 809 809 convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols 810 810 DO ij = ip1jm+1,ip1jmp1 -
LMDZ6/branches/Amaury_dev/libf/misc/cray.F
r1907 r5081 15 15 iy=1 16 16 ix=1 17 do 10i=1,n17 DO i=1,n 18 18 sy(iy)=sx(ix) 19 19 ix=ix+incx 20 20 iy=iy+incy 21 10 continue 21 END DO 22 22 c 23 23 return … … 33 33 ssum=0. 34 34 ix=1 35 do 10i=1,n35 do i=1,n 36 36 ssum=ssum+sx(ix) 37 37 ix=ix+incx 38 10 continue 38 end do 39 39 c 40 40 return -
LMDZ6/branches/Amaury_dev/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90
r4600 r5081 65 65 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 66 66 67 !! -- Les chaine de charact ère -- !!67 !! -- Les chaine de charact�re -- !! 68 68 69 69 SUBROUTINE bcast_mpi_c(var1) -
LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/cond_evap_tstep_mod.F90
r4950 r5081 227 227 ! H2SO4 mass fraction in aerosol 228 228 WH2=R2SO4*1.0E-2 229 IF(WH2 .EQ.0.0) RETURN229 IF(WH2==0.0) RETURN 230 230 ! ACTIVITY COEFFICIENT(SEE GIAUQUE,1951) 231 231 ! AYERS ET AL (1980) … … 324 324 ff(IK,:)=0.0 325 325 DO k=1, nbtr_bin 326 IF (k .LE.(nbtr_bin-1)) THEN327 IF (Vbin_wet(k) .LE.Vnew.AND.Vnew.LT.Vbin_wet(k+1)) THEN326 IF (k<=(nbtr_bin-1)) THEN 327 IF (Vbin_wet(k)<=Vnew.AND.Vnew<Vbin_wet(k+1)) THEN 328 328 ff(IK,k)= Vbin_wet(k)/Vnew*(Vbin_wet(k+1)-Vnew)/(Vbin_wet(k+1)-Vbin_wet(k)) 329 329 ENDIF 330 330 ENDIF 331 IF (k .EQ.1.AND.Vnew.LE.Vbin_wet(k)) THEN331 IF (k==1.AND.Vnew<=Vbin_wet(k)) THEN 332 332 ff(IK,k)= 1. 333 333 ENDIF 334 IF (k .GT.1) THEN335 IF (Vbin_wet(k-1) .LT.Vnew.AND.Vnew.LT.Vbin_wet(k)) THEN334 IF (k>1) THEN 335 IF (Vbin_wet(k-1)<Vnew.AND.Vnew<Vbin_wet(k)) THEN 336 336 ff(IK,k)= 1.-ff(IK,k-1) 337 337 ENDIF 338 338 ENDIF 339 IF (k .EQ.nbtr_bin.AND.Vnew.GE.Vbin_wet(k)) THEN339 IF (k==nbtr_bin.AND.Vnew>=Vbin_wet(k)) THEN 340 340 ff(IK,k)= 1. 341 341 ENDIF -
LMDZ6/branches/Amaury_dev/libf/phylmd/YOECUMF.h
r1907 r5081 12 12 ! 13 13 COMMON /YOECUMF/ & 14 & LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV, &15 14 & ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP, & 16 & CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON 15 & CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON, & 16 & LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV 17 17 18 18 19 LOGICAL LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV -
LMDZ6/branches/Amaury_dev/libf/phylmd/aaam_bud.F90
r2350 r5081 127 127 hadley = 1.E18 128 128 hadday = 1.E18*24.*3600. 129 IF(klon_glo .EQ.1) THEN129 IF(klon_glo==1) THEN 130 130 dlat = xpi 131 131 ELSE -
LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90
r3977 r5081 358 358 CMAX*2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.) 359 359 END DO 360 IF (CPHA .LT.0.) THEN360 IF (CPHA<0.) THEN 361 361 CPHA = -1.*CPHA 362 362 ZP(JW,II) = ZP(JW,II) + RPI -
LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90
r5051 r5081 226 226 ENDDO 227 227 228 IF (fl_ebil .GT.0) THEN228 IF (fl_ebil > 0) THEN 229 229 ! ------------------------------------------------ 230 230 ! Compute vertical sum for each atmospheric column … … 283 283 !===================================================================================== 284 284 285 IF (jbad .GT.0) THEN285 IF (jbad > 0) THEN 286 286 DO j = 1, jbad 287 287 i=jadrs(j) 288 IF (prt_level .ge.debug_level) THEN288 IF (prt_level>=debug_level) THEN 289 289 print*,'PLANTAGE POUR LE POINT i lon lat =',& 290 290 i,longitude_deg(i),latitude_deg(i),text … … 301 301 ! Impression, warning et correction en cas de probleme moins important 302 302 !===================================================================================== 303 IF (jqbad .GT.0) THEN303 IF (jqbad > 0) THEN 304 304 done(:) = .false. !jyg 305 305 DO j = 1, jqbad 306 306 i=jqadrs(j) 307 if(prt_level .ge.debug_level) THEN307 if(prt_level>=debug_level) THEN 308 308 print*,'WARNING : EAU POUR LE POINT i lon lat =',& 309 309 i,longitude_deg(i),latitude_deg(i),text … … 325 325 zqp_int = zqp_int + zqp(k) *(paprs(i,k)-paprs(i,k+1))/Rg 326 326 ENDDO 327 IF (prt_level .ge.debug_level) THEN327 IF (prt_level>=debug_level) THEN 328 328 print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', & 329 329 i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int … … 340 340 DO k = 1, klev 341 341 zq=q_seri(i,k)+zdq(i,k) 342 IF (zq .lt.1.e-15) THEN343 IF (q_seri(i,k) .lt.1.e-15) THEN344 IF (prt_level .ge.debug_level) THEN342 IF (zq<1.e-15) THEN 343 IF (q_seri(i,k)<1.e-15) THEN 344 IF (prt_level>=debug_level) THEN 345 345 print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k) 346 346 ENDIF … … 383 383 ENDDO 384 384 ENDDO 385 IF (jbad .GT.0) THEN385 IF (jbad > 0) THEN 386 386 DO j = 1, jbad 387 387 i=jadrs(j) 388 388 k=kadrs(j) 389 if(prt_level .ge.debug_level) THEN389 if(prt_level>=debug_level) THEN 390 390 print*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',& 391 391 i,itap,longitude_deg(i),latitude_deg(i),text,jbad, & … … 401 401 ENDIF 402 402 ! 403 IF (jqbad .GT.0) THEN403 IF (jqbad > 0) THEN 404 404 DO j = 1, jqbad 405 405 i=jqadrs(j) 406 406 k=kqadrs(j) 407 IF (prt_level .ge.debug_level) THEN407 IF (prt_level>=debug_level) THEN 408 408 print*,'WARNING : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',& 409 409 i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,& … … 441 441 !====================================================================== 442 442 443 IF (fl_ebil .GT.0) THEn443 IF (fl_ebil > 0) THEn 444 444 445 445 ! ------------------------------------------------ … … 584 584 ENDDO 585 585 586 IF (fl_ebil .GT.0) THEN586 IF (fl_ebil > 0) THEN 587 587 ! ------------------------------------------------ 588 588 ! Compute vertical sum for each atmospheric column … … 613 613 !====================================================================== 614 614 615 IF (fl_ebil .GT.0) THEN615 IF (fl_ebil > 0) THEN 616 616 617 617 ! ------------------------------------------------ … … 761 761 762 762 !!print *,'prt_level:',prt_level,' fl_ebil:',fl_ebil,' fl_cor_ebil:',fl_cor_ebil 763 IF ((fl_ebil .GT. 0) .AND. (klon .EQ.1)) THEN763 IF ((fl_ebil > 0) .AND. (klon == 1)) THEN 764 764 765 765 bilq_bnd = 0. … … 793 793 bilh_error = d_h_col(1) - bilh_bnd 794 794 ! are the errors too large? 795 IF (abs(bilq_error) .GT.bilq_seuil) bilq_ok=1796 IF (abs(bilh_error) .GT.bilh_seuil) bilh_ok=1795 IF (abs(bilq_error) > bilq_seuil) bilq_ok=1 796 IF (abs(bilh_error) > bilh_seuil) bilh_ok=1 797 797 ! 798 798 ! Print diagnostics 799 799 ! ================= 800 IF ( (bilq_ok .eq. 0).AND.(bilh_ok .eq.0) ) THEN800 IF ( (bilq_ok == 0).AND.(bilh_ok == 0) ) THEN 801 801 status="enerbil-OK" 802 802 ELSE … … 804 804 ENDIF 805 805 806 IF (prt_level .GE.3) THEN806 IF (prt_level >= 3) THEN 807 807 write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error," H", bilh_error 808 808 9010 format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6) 809 809 ENDIF 810 IF (prt_level .GE.3) THEN810 IF (prt_level >= 3) THEN 811 811 write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1) 812 812 ENDIF 813 IF (prt_level .GE.5) THEN813 IF (prt_level >= 5) THEN 814 814 write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd 815 815 write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1) … … 819 819 specific_diag: SELECT CASE (text) 820 820 CASE("vdf") specific_diag 821 IF (prt_level .GE.5) THEN821 IF (prt_level >= 5) THEN 822 822 write(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1) 823 823 write(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1) 824 824 ENDIF 825 825 CASE("lsc") specific_diag 826 IF (prt_level .GE.5) THEN826 IF (prt_level >= 5) THEN 827 827 write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_lsc(1), rlvtt * rain_lsc(1), -(rcw-rcpd)*t_seri(1,1) * rain_lsc(1) 828 828 write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_lsc(1), rlstt * snow_lsc(1), -(rcs-rcpd)*t_seri(1,1) * snow_lsc(1) 829 829 ENDIF 830 830 CASE("convection") specific_diag 831 IF (prt_level .GE.5) THEN831 IF (prt_level >= 5) THEN 832 832 write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_con(1), rlvtt * rain_con(1), -(rcw-rcpd)*t_seri(1,1) * rain_con(1) 833 833 write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_con(1), rlstt * snow_con(1), -(rcs-rcpd)*t_seri(1,1) * snow_con(1) -
LMDZ6/branches/Amaury_dev/libf/phylmd/add_wake_tend.F90
r4744 r5081 1 1 SUBROUTINE add_wake_tend(zddeltat, zddeltaq, zds, zdas, zddensw, zddensaw, zoccur, text, abortphy) 2 2 !=================================================================== 3 ! Ajoute les tendances li ées aux diverses parametrisations physiques aux3 ! Ajoute les tendances li�es aux diverses parametrisations physiques aux 4 4 ! variables d'etat des poches froides. 5 5 !=================================================================== … … 43 43 DO l = 1, klev 44 44 DO i = 1, klon 45 IF (zoccur(i) .GE.1) THEN45 IF (zoccur(i) >= 1) THEN 46 46 wake_deltat(i, l) = wake_deltat(i, l) + zddeltat(i,l) 47 47 wake_deltaq(i, l) = wake_deltaq(i, l) + zddeltaq(i,l) … … 53 53 END DO 54 54 DO i = 1, klon 55 IF (zoccur(i) .GE.1) THEN55 IF (zoccur(i) >= 1) THEN 56 56 wake_s(i) = wake_s(i) + zds(i) 57 57 awake_s(i) = awake_s(i) + zdas(i) -
LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.h
r4843 r5081 14 14 15 15 common/calpale1/iflag_trig_bl,iflag_clos_bl,tau_trig_shallow,tau_trig_deep,iflag_strig 16 common/calpale2/ s_trig,iflag_coupl,iflag_clos,iflag_wake,alp_bl_k,h_trig16 common/calpale2/alp_bl_k,s_trig,h_trig,iflag_coupl,iflag_clos,iflag_wake 17 17 18 18 !$OMP THREADPRIVATE(/calpale1/,/calpale2/) -
LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_wk.F90
r3068 r5081 58 58 !! print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1) 59 59 DO i = 1,klon 60 IF (zoccur(i) .GE.1) THEN60 IF (zoccur(i) >= 1) THEN 61 61 wkrad(i) = sqrt(sigmaw(i)/(rpi*wdens(i))) 62 62 ELSE -
LMDZ6/branches/Amaury_dev/libf/phylmd/clesphys.h
r5017 r5081 133 133 & , qsol0,albsno0,evap0 & 134 134 & , co2_ppm0 & 135 & , tau_thermals & 135 136 !FC 136 137 & , Cd_frein,zrel_oro_t,zpmm_orodr_t,zpmm_orolf_t,zstd_orodr_t & … … 163 164 & , ok_daily_climoz, ok_all_xml, ok_lwoff & 164 165 & , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs & 165 & , iflag_thermals,nsplit_thermals , tau_thermals&166 & , iflag_thermals,nsplit_thermals & 166 167 & , iflag_physiq, ok_3Deffect, ok_water_mass_fixer 167 168 save /clesphys/ -
LMDZ6/branches/Amaury_dev/libf/phylmd/climb_hq_mod.F90
r3102 r5081 7 7 8 8 IMPLICIT NONE 9 SAVE10 9 PRIVATE 11 10 PUBLIC :: climb_hq_down, climb_hq_up, d_h_col_vdf, f_h_bnd … … 222 221 !!! jyg le 07/02/2012 223 222 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN 224 IF (mod(iflag_pbl_split,10) .ge.1) THEN223 IF (mod(iflag_pbl_split,10) >=1) THEN 225 224 !!! nrlmd le 02/05/2011 226 225 DO k= 1, klev … … 231 230 Dcoef_Q_out(i,k) = Dcoef_Q(i,k) 232 231 Kcoef_hq_out(i,k) = Kcoefhq(i,k) 233 IF (k .eq.1) THEN232 IF (k==1) THEN 234 233 gama_h_out(i,k) = 0. 235 234 gama_q_out(i,k) = 0. … … 379 378 !!! jyg le 07/02/2012 380 379 !!jyg IF (mod(iflag_pbl_split,2) .eq.1) THEN 381 IF (mod(iflag_pbl_split,10) .ge.1) THEN380 IF (mod(iflag_pbl_split,10) >=1) THEN 382 381 !!! nrlmd le 02/05/2011 383 382 DO i = 1, knon … … 394 393 Dcoef_Q(i,k)=Dcoef_Q_in(i,k) 395 394 Kcoefhq(i,k)=Kcoef_hq_in(i,k) 396 IF (k .gt.1) THEN395 IF (k>1) THEN 397 396 gamah(i,k)=gama_h_in(i,k) 398 397 gamaq(i,k)=gama_q_in(i,k) -
LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90
r4843 r5081 1352 1352 !Config Help = 1353 1353 ! 1354 ok_ice_sursat_omp = 01354 ok_ice_sursat_omp = .FALSE. 1355 1355 CALL getin('ok_ice_sursat',ok_ice_sursat_omp) 1356 1356 … … 2574 2574 2575 2575 !--test on radiative scheme 2576 IF (iflag_rrtm .EQ. 0) THEN2577 IF (NSW .NE.2) THEN2576 IF (iflag_rrtm == 0) THEN 2577 IF (NSW/=2) THEN 2578 2578 WRITE(lunout,*) ' ERROR iflag_rrtm=0 and NSW<>2 not possible' 2579 2579 CALL abort_physic('conf_phys','choice NSW not valid',1) 2580 2580 ENDIF 2581 ELSE IF (iflag_rrtm .EQ.1) THEN2582 IF (NSW .NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN2581 ELSE IF (iflag_rrtm == 1) THEN 2582 IF (NSW/=2.AND.NSW/=4.AND.NSW/=6) THEN 2583 2583 WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible' 2584 2584 CALL abort_physic('conf_phys','choice NSW not valid',1) 2585 2585 ENDIF 2586 ELSE IF (iflag_rrtm .EQ.2) THEN2587 IF (NSW .NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN2586 ELSE IF (iflag_rrtm == 2) THEN 2587 IF (NSW/=2.AND.NSW/=4.AND.NSW/=6) THEN 2588 2588 WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible' 2589 2589 CALL abort_physic('conf_phys','choice NSW not valid',1) … … 2610 2610 2611 2611 !--test on ocean surface albedo 2612 IF (iflag_albedo .LT.0.OR.iflag_albedo.GT.2) THEN2612 IF (iflag_albedo<0.OR.iflag_albedo>2) THEN 2613 2613 WRITE(lunout,*) ' ERROR iflag_albedo<>0,1' 2614 2614 CALL abort_physic('conf_phys','choice iflag_albedo not valid',1) … … 2617 2617 ! Flag_aerosol cannot be set to zero if aerosol direct effect (ade) or aerosol indirect effect (aie) are activated 2618 2618 IF (ok_ade .OR. ok_aie) THEN 2619 IF ( flag_aerosol .EQ.0 ) THEN2619 IF ( flag_aerosol == 0 ) THEN 2620 2620 CALL abort_physic('conf_phys','flag_aerosol=0 not compatible avec ok_ade ou ok_aie=.TRUE.',1) 2621 2621 ENDIF … … 2623 2623 2624 2624 ! Flag_aerosol cannot be set to zero if we are in coupled mode for aerosol 2625 IF (aerosol_couple .AND. flag_aerosol .EQ.0 ) THEN2625 IF (aerosol_couple .AND. flag_aerosol == 0 ) THEN 2626 2626 CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if aerosol_couple=y ', 1) 2627 2627 ENDIF 2628 2628 2629 2629 ! Read_climoz needs to be set zero if we are in couple mode for chemistry 2630 IF (chemistry_couple .AND. read_climoz .ne. 0) THEN2630 IF (chemistry_couple .AND. read_climoz /= 0) THEN 2631 2631 CALL abort_physic('conf_phys', 'read_climoz need to be to zero if chemistry_couple=y ', 1) 2632 2632 ENDIF 2633 2633 2634 2634 ! flag_aerosol need to be different to zero if ok_cdnc is activated 2635 IF (ok_cdnc .AND. flag_aerosol .EQ.0) THEN2635 IF (ok_cdnc .AND. flag_aerosol == 0) THEN 2636 2636 CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if ok_cdnc is activated ', 1) 2637 2637 ENDIF … … 2643 2643 2644 2644 ! flag_aerosol=7 => MACv2SP climatology 2645 IF (flag_aerosol .EQ.7.AND. iflag_rrtm.NE.1) THEN2645 IF (flag_aerosol==7.AND. iflag_rrtm/=1) THEN 2646 2646 CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with RRTM',1) 2647 2647 ENDIF 2648 IF (flag_aerosol .EQ.7.AND. NSW.NE.6) THEN2648 IF (flag_aerosol==7.AND. NSW/=6) THEN 2649 2649 CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with NSW=6',1) 2650 2650 ENDIF 2651 2651 2652 2652 ! BC internal mixture is only possible with RRTM & NSW=6 & flag_aerosol=6 or aerosol_couple 2653 IF (flag_bc_internal_mixture .AND. NSW .NE.6) THEN2653 IF (flag_bc_internal_mixture .AND. NSW/=6) THEN 2654 2654 CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with NSW=6',1) 2655 2655 ENDIF 2656 IF (flag_bc_internal_mixture .AND. iflag_rrtm .NE.1) THEN2656 IF (flag_bc_internal_mixture .AND. iflag_rrtm/=1) THEN 2657 2657 CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with RRTM',1) 2658 2658 ENDIF 2659 IF (flag_bc_internal_mixture .AND. flag_aerosol .NE.6) THEN2659 IF (flag_bc_internal_mixture .AND. flag_aerosol/=6) THEN 2660 2660 CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with flag_aerosol=6',1) 2661 2661 ENDIF 2662 2662 2663 2663 ! test sur flag_volc_surfstrat 2664 IF (flag_volc_surfstrat .LT.0.OR.flag_volc_surfstrat.GT.2) THEN2664 IF (flag_volc_surfstrat<0.OR.flag_volc_surfstrat>2) THEN 2665 2665 CALL abort_physic('conf_phys', 'flag_volc_surfstrat can only be 0 1 or 2',1) 2666 2666 ENDIF 2667 IF ((.NOT.ok_volcan.OR..NOT.ok_ade.OR..NOT.ok_aie).AND.flag_volc_surfstrat .GT.0) THEN2667 IF ((.NOT.ok_volcan.OR..NOT.ok_ade.OR..NOT.ok_aie).AND.flag_volc_surfstrat>0) THEN 2668 2668 CALL abort_physic('conf_phys', 'ok_ade, ok_aie, ok_volcan need to be activated if flag_volc_surfstrat is 1 or 2',1) 2669 2669 ENDIF … … 2679 2679 2680 2680 ! Test on chemistry cycle 2681 IF ((type_trac .ne. "inca" .AND. type_trac .ne. "inco") .AND. ( dms_cycle_cpl .OR. n2o_cycle_cpl) ) THEN2681 IF ((type_trac /= "inca" .AND. type_trac /= "inco") .AND. ( dms_cycle_cpl .OR. n2o_cycle_cpl) ) THEN 2682 2682 CALL abort_physic('conf_phys', 'dms_cycle_cpl or n2o_cycle_cpl has to be TRUE only with INCA coupling model',1) 2683 2683 ENDIF -
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/m_mrgrnk.F90
r3241 r5081 33 33 IRNGT (1) = 1 34 34 Return 35 Case Default36 Continue37 35 End Select 38 36 ! … … 233 231 IRNGT (1) = 1 234 232 Return 235 Case Default236 Continue237 233 End Select 238 234 ! -
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90
r2428 r5081 38 38 39 39 ! ----- INPUTS ----- 40 real *8, intent(in) :: freq,tk40 real(kind=8), intent(in) :: freq,tk 41 41 42 42 ! ----- OUTPUTS ----- 43 real *8, intent(out) :: n_r, n_i43 real(kind=8), intent(out) :: n_r, n_i 44 44 45 45 ! ----- INTERNAL ----- 46 real *8ld,es,ei,a,ls,sg,tm1,cos1,sin147 real *8e_r,e_i48 real *8pi49 real *8tc50 complex *16e_comp, sq46 real(kind=8) ld,es,ei,a,ls,sg,tm1,cos1,sin1 47 real(kind=8) e_r,e_i 48 real(kind=8) pi 49 real(kind=8) tc 50 complex(kind=8) e_comp, sq 51 51 52 52 tc = tk - 273.15 … … 102 102 103 103 ! ----- INPUTS ----- 104 real *8, intent(in) :: freq, t104 real(kind=8), intent(in) :: freq, t 105 105 106 106 ! ----- OUTPUTS ----- 107 real *8, intent(out) :: n_r,n_i107 real(kind=8), intent(out) :: n_r,n_i 108 108 109 109 ! Parameters: 110 integer *2:: i,lt1,lt2,nwl,nwlt110 integer(kind=2) :: i,lt1,lt2,nwl,nwlt 111 111 parameter(nwl=468,nwlt=62) 112 112 113 real *8:: alam,cutice,pi,t1,t2,wlmax,wlmin, &113 real(kind=8) :: alam,cutice,pi,t1,t2,wlmax,wlmin, & 114 114 x,x1,x2,y,y1,y2,ylo,yhi,tk 115 115 116 real *8:: &116 real(kind=8) :: & 117 117 tabim(nwl),tabimt(nwlt,4),tabre(nwl),tabret(nwlt,4),temref(4), & 118 118 wl(nwl),wlt(nwlt) … … 540 540 if(tk < temref(4)) tk=temref(4) 541 541 do 11 i=2,4 542 if(tk .ge.temref(i)) go to 12542 if(tk>=temref(i)) go to 12 543 543 11 continue 544 544 12 lt1=i 545 545 lt2=i-1 546 546 do 13 i=2,nwlt 547 if(alam .le.wlt(i)) go to 14547 if(alam<=wlt(i)) go to 14 548 548 13 continue 549 549 14 x1=log(wlt(i-1)) … … 586 586 Subroutine MieInt(Dx, SCm, Inp, Dqv, Dqxt, Dqsc, Dbsc, Dg, Xs1, Xs2, DPh, Error) 587 587 588 Integer * 2Imaxx588 Integer (kind=2) Imaxx 589 589 Parameter (Imaxx = 12000) 590 Real * 4RIMax ! largest real part of refractive index590 Real (kind=4) RIMax ! largest real part of refractive index 591 591 Parameter (RIMax = 2.5) 592 Real * 4IRIMax ! largest imaginary part of refractive index592 Real (kind=4) IRIMax ! largest imaginary part of refractive index 593 593 Parameter (IRIMax = -2) 594 Integer * 2Itermax594 Integer (kind=2) Itermax 595 595 Parameter (Itermax = 12000 * 2.5) 596 596 ! must be large enough to cope with the 597 597 ! largest possible nmx = x * abs(scm) + 15 598 598 ! or nmx = Dx + 4.05*Dx**(1./3.) + 2.0 599 Integer * 2Imaxnp599 Integer (kind=2) Imaxnp 600 600 Parameter (Imaxnp = 10000) ! Change this as required 601 601 ! INPUT 602 Real * 8Dx603 Complex * 16SCm604 Integer * 4Inp605 Real * 8Dqv(Inp)602 Real (kind=8) Dx 603 Complex (kind=8) SCm 604 Integer (kind=4) Inp 605 Real (kind=8) Dqv(Inp) 606 606 ! OUTPUT 607 Complex * 16Xs1(InP)608 Complex * 16Xs2(InP)609 Real * 8Dqxt610 Real * 8Dqsc611 Real * 8Dg612 Real * 8Dbsc613 Real * 8DPh(InP)614 Integer * 4Error607 Complex (kind=8) Xs1(InP) 608 Complex (kind=8) Xs2(InP) 609 Real (kind=8) Dqxt 610 Real (kind=8) Dqsc 611 Real (kind=8) Dg 612 Real (kind=8) Dbsc 613 Real (kind=8) DPh(InP) 614 Integer (kind=4) Error 615 615 ! LOCAL 616 Integer * 2I617 Integer * 2NStop618 Integer * 2NmX619 Integer * 4N ! N*N > 32767 ie N > 181620 Integer * 4Inp2621 Real * 8Chi,Chi0,Chi1622 Real * 8APsi,APsi0,APsi1623 Real * 8Pi0(Imaxnp)624 Real * 8Pi1(Imaxnp)625 Real * 8Taun(Imaxnp)626 Real * 8Psi,Psi0,Psi1627 Complex * 8Ir628 Complex * 16Cm629 Complex * 16A,ANM1,APB630 Complex * 16B,BNM1,AMB631 Complex * 16D(Itermax)632 Complex * 16Sp(Imaxnp)633 Complex * 16Sm(Imaxnp)634 Complex * 16Xi,Xi0,Xi1635 Complex * 16Y616 Integer (kind=2) I 617 Integer (kind=2) NStop 618 Integer (kind=2) NmX 619 Integer (kind=4) N ! N*N > 32767 ie N > 181 620 Integer (kind=4) Inp2 621 Real (kind=8) Chi,Chi0,Chi1 622 Real (kind=8) APsi,APsi0,APsi1 623 Real (kind=8) Pi0(Imaxnp) 624 Real (kind=8) Pi1(Imaxnp) 625 Real (kind=8) Taun(Imaxnp) 626 Real (kind=8) Psi,Psi0,Psi1 627 Complex (kind=4) Ir 628 Complex (kind=8) Cm 629 Complex (kind=8) A,ANM1,APB 630 Complex (kind=8) B,BNM1,AMB 631 Complex (kind=8) D(Itermax) 632 Complex (kind=8) Sp(Imaxnp) 633 Complex (kind=8) Sm(Imaxnp) 634 Complex (kind=8) Xi,Xi0,Xi1 635 Complex (kind=8) Y 636 636 ! ACCELERATOR VARIABLES 637 Integer * 2Tnp1638 Integer * 2Tnm1639 Real * 8Dn640 Real * 8Rnx641 Real * 8S(Imaxnp)642 Real * 8T(Imaxnp)643 Real * 8Turbo644 Real * 8A2645 Complex * 16A1637 Integer (kind=2) Tnp1 638 Integer (kind=2) Tnm1 639 Real (kind=8) Dn 640 Real (kind=8) Rnx 641 Real (kind=8) S(Imaxnp) 642 Real (kind=8) T(Imaxnp) 643 Real (kind=8) Turbo 644 Real (kind=8) A2 645 Complex (kind=8) A1 646 646 647 If ((Dx .Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then647 If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then 648 648 Error = 1 649 649 Return … … 652 652 Ir = 1 / Cm 653 653 Y = Dx * Cm 654 If (Dx .Lt.0.02) Then654 If (Dx<0.02) Then 655 655 NStop = 2 656 656 Else 657 If (Dx .Le.8.0) Then657 If (Dx<=8.0) Then 658 658 NStop = Dx + 4.00*Dx**(1./3.) + 2.0 659 659 Else 660 If (Dx .Lt.4200.0) Then660 If (Dx< 4200.0) Then 661 661 NStop = Dx + 4.05*Dx**(1./3.) + 2.0 662 662 Else … … 666 666 End If 667 667 NmX = Max(Real(NStop),Real(Abs(Y))) + 15. 668 If (Nmx .gt.Itermax) then668 If (Nmx > Itermax) then 669 669 Error = 1 670 670 Return … … 709 709 Dqxt = Tnp1 * Dble(A + B) + Dqxt 710 710 Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc 711 If (N .Gt.1) then711 If (N>1) then 712 712 Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN) 713 713 End If … … 717 717 AMB = A2 * (A - B) 718 718 Do I = 1,Inp2 719 If (I .GT.Inp) Then719 If (I>Inp) Then 720 720 S(I) = -Pi1(I) 721 721 Else … … 736 736 Xi1 = Dcmplx(APsi1,Chi1) 737 737 End Do 738 If (Dg .GT.0) Dg = 2 * Dg / Dqsc738 If (Dg >0) Dg = 2 * Dg / Dqsc 739 739 Dqsc = 2 * Dqsc / Dx**2 740 740 Dqxt = 2 * Dqxt / Dx**2 -
LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/mrgrnk.F90
r3358 r5081 68 68 IRNGT (1) = 1 69 69 Return 70 Case Default71 Continue72 70 End Select 73 71 ! … … 268 266 IRNGT (1) = 1 269 267 Return 270 Case Default271 Continue272 268 End Select 273 269 ! … … 467 463 IRNGT (1) = 1 468 464 Return 469 Case Default470 Continue471 465 End Select 472 466 ! -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90
r3491 r5081 72 72 varOUT(1:dim1,1:dim2,1:dim3) = 0._wp 73 73 do j=1,dim2 74 where(flag(:,j,:) .eq.1)74 where(flag(:,j,:) == 1) 75 75 varOUT(:,j,:) = varIN2 76 76 endwhere 77 where(flag(:,j,:) .eq.2)77 where(flag(:,j,:) == 2) 78 78 varOUT(:,j,:) = varIN1 79 79 endwhere … … 96 96 97 97 varOUT(1:dim1,1:dim2,1:dim3) = 0._wp 98 where(flag(:,:,:) .eq.1)98 where(flag(:,:,:) == 1) 99 99 varOUT(:,:,:) = varIN2 100 100 endwhere 101 where(flag(:,:,:) .eq.2)101 where(flag(:,:,:) == 2) 102 102 varOUT(:,:,:) = varIN1 103 103 endwhere … … 295 295 296 296 ! Which LIDAR frequency are we using? 297 if (lidar_freq .eq.355) then297 if (lidar_freq == 355) then 298 298 Cmol = Cmol_355nm 299 299 rdiffm = rdiffm_355nm 300 300 endif 301 if (lidar_freq .eq.532) then301 if (lidar_freq == 532) then 302 302 Cmol = Cmol_532nm 303 303 rdiffm = rdiffm_532nm … … 336 336 337 337 ! LS and CONV Ice water coefficients 338 if (ice_type .eq.0) then338 if (ice_type == 0) then 339 339 polpart(INDX_LSICE,1:5) = polpartLSICE0 340 340 polpart(INDX_CVICE,1:5) = polpartCVICE0 341 341 endif 342 if (ice_type .eq.1) then342 if (ice_type == 1) then 343 343 polpart(INDX_LSICE,1:5) = polpartLSICE1 344 344 polpart(INDX_CVICE,1:5) = polpartCVICE1 … … 393 393 ! Polynomials kp_lidar derived from Mie theory 394 394 do i = 1, npart 395 where (rad_part(1:npoints,1:nlev,i) .gt.0.0)395 where (rad_part(1:npoints,1:nlev,i) > 0.0) 396 396 kp_part(1:npoints,1:nlev,i) = & 397 397 polpart(i,1)*(rad_part(1:npoints,1:nlev,i)*1e6)**4 & … … 426 426 ! Alpha of particles in each subcolumn: 427 427 do i = 1, npart 428 where (rad_part(1:npoints,1:nlev,i) .gt.0.0)428 where (rad_part(1:npoints,1:nlev,i) > 0.0) 429 429 alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat & 430 430 * rhoair(1:npoints,1:nlev) * qpart(1:npoints,1:nlev,i) & -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/mrgrnk.F90
r3491 r5081 68 68 IRNGT (1) = 1 69 69 Return 70 Case Default71 Continue72 70 End Select 73 71 ! … … 268 266 IRNGT (1) = 1 269 267 Return 270 Case Default271 Continue272 268 End Select 273 269 ! … … 467 463 IRNGT (1) = 1 468 464 Return 469 Case Default470 Continue471 465 End Select 472 466 ! -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90
r3491 r5081 558 558 if(tk < temref(4)) tk=temref(4) 559 559 do i=2,4 560 if(tk .ge.temref(i)) go to 12560 if(tk>=temref(i)) go to 12 561 561 enddo 562 562 12 lt1 = i 563 563 lt2 = i-1 564 564 do i=2,nwlt 565 if(alam .le.wlt(i)) go to 14565 if(alam<=wlt(i)) go to 14 566 566 enddo 567 567 14 x1 = log(wlt(i-1)) … … 652 652 Complex(wp) :: A1 653 653 654 If ((Dx .Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then654 If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then 655 655 Error = 1 656 656 Return … … 659 659 Ir = 1 / Cm 660 660 Y = Dx * Cm 661 If (Dx .Lt.0.02) Then661 If (Dx<0.02) Then 662 662 NStop = 2 663 663 Else 664 If (Dx .Le.8.0) Then664 If (Dx<=8.0) Then 665 665 NStop = Dx + 4.00*Dx**(1./3.) + 2.0 666 666 Else 667 If (Dx .Lt.4200.0) Then667 If (Dx< 4200.0) Then 668 668 NStop = Dx + 4.05*Dx**(1./3.) + 2.0 669 669 Else … … 673 673 End If 674 674 NmX = Max(Real(NStop),Real(Abs(Y))) + 15. 675 If (Nmx .gt.Itermax) then675 If (Nmx > Itermax) then 676 676 Error = 1 677 677 Return … … 726 726 !ds Dqxt = Tnp1 * Dble(A + B) + Dqxt 727 727 Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc 728 If (N .Gt.1) then728 If (N>1) then 729 729 Dg = Dg + (dN*dN - 1) * (ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 *(ANM1*Conjg(BNM1)) / (dN*dN - dN) 730 730 !ds Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN) … … 735 735 AMB = A2 * (A - B) 736 736 Do I = 1,Inp2 737 If (I .GT.Inp) Then737 If (I>Inp) Then 738 738 S(I) = -Pi1(I) 739 739 Else … … 756 756 End Do 757 757 758 If (Dg .GT.0) Dg = 2 * Dg / Dqsc758 If (Dg >0) Dg = 2 * Dg / Dqsc 759 759 Dqsc = 2 * Dqsc / Dx**2 760 760 Dqxt = 2 * Dqxt / Dx**2 -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90
r3491 r5081 179 179 180 180 ! Attenuation due to gaseous absorption between radar and volume 181 if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr .eq.1)) then181 if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr == 1)) then 182 182 if (d_gate==1) then 183 183 if (k>1) then … … 272 272 273 273 ! Which platforms to create diagnostics for? 274 if (platform .eq.'cloudsat') lcloudsat=.true.274 if (platform == 'cloudsat') lcloudsat=.true. 275 275 276 276 ! Create Cloudsat diagnostics. … … 289 289 enddo 290 290 enddo 291 where(cfad_ze .ne.R_UNDEF) cfad_ze = cfad_ze/Ncolumns291 where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns 292 292 293 293 ! Compute cloudsat near-surface precipitation diagnostics … … 306 306 enddo 307 307 enddo 308 where(cfad_ze .ne.R_UNDEF) cfad_ze = cfad_ze/Ncolumns308 where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns 309 309 endif 310 310 endif … … 402 402 do pr=1,Ncolumns 403 403 ! 1) Compute the PIA in all profiles containing hydrometeors 404 if ( (Ze_non_out(i,pr,cloudsat_preclvl) .gt.-100) .and. (Ze_out(i,pr,cloudsat_preclvl).gt.-100) ) then405 if ( (Ze_non_out(i,pr,cloudsat_preclvl) .lt.100) .and. (Ze_out(i,pr,cloudsat_preclvl).lt.100) ) then404 if ( (Ze_non_out(i,pr,cloudsat_preclvl)>-100) .and. (Ze_out(i,pr,cloudsat_preclvl)>-100) ) then 405 if ( (Ze_non_out(i,pr,cloudsat_preclvl)<100) .and. (Ze_out(i,pr,cloudsat_preclvl)<100) ) then 406 406 cloudsat_precip_pia(i,pr) = Ze_non_out(i,pr,cloudsat_preclvl) - Ze_out(i,pr,cloudsat_preclvl) 407 407 endif … … 412 412 ! 2a) Oceanic points. 413 413 ! ################################################################################ 414 if (land(i) .eq.0) then414 if (land(i) == 0) then 415 415 ! print*, 'aaa i, pr, fracPrecipIce(i,pr) : ', i, pr, fracPrecipIce(i,pr) !Artem 416 416 ! Snow 417 if(fracPrecipIce(i,pr) .gt.0.9) then418 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(2)) then417 if(fracPrecipIce(i,pr)>0.9) then 418 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(2)) then 419 419 cloudsat_pflag(i,pr) = pClass_Snow2 ! TSL: Snow certain 420 420 endif 421 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(4).and. &422 Ze_non_out(i,pr,cloudsat_preclvl) .le.Zenonbinval(2)) then421 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. & 422 Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then 423 423 cloudsat_pflag(i,pr) = pClass_Snow1 ! TSL: Snow possible 424 424 endif … … 426 426 427 427 ! Mixed 428 if(fracPrecipIce(i,pr) .gt.0.1.and.fracPrecipIce(i,pr).le.0.9) then429 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(2)) then428 if(fracPrecipIce(i,pr)>0.1.and.fracPrecipIce(i,pr)<=0.9) then 429 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(2)) then 430 430 cloudsat_pflag(i,pr) = pClass_Mixed2 ! TSL: Mixed certain 431 431 endif 432 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(4).and. &433 Ze_non_out(i,pr,cloudsat_preclvl) .le.Zenonbinval(2)) then432 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. & 433 Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then 434 434 cloudsat_pflag(i,pr) = pClass_Mixed1 ! TSL: Mixed possible 435 435 endif … … 437 437 438 438 ! Rain 439 if(fracPrecipIce(i,pr) .le.0.1) then440 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(1)) then439 if(fracPrecipIce(i,pr)<=0.1) then 440 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(1)) then 441 441 cloudsat_pflag(i,pr) = pClass_Rain3 ! TSL: Rain certain 442 442 endif 443 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(3).and. &444 Ze_non_out(i,pr,cloudsat_preclvl) .le.Zenonbinval(1)) then443 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(3).and. & 444 Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(1)) then 445 445 cloudsat_pflag(i,pr) = pClass_Rain2 ! TSL: Rain probable 446 446 endif 447 if(Ze_non_out(i,pr,cloudsat_preclvl) .gt.Zenonbinval(4).and. &448 Ze_non_out(i,pr,cloudsat_preclvl) .le.Zenonbinval(3)) then447 if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. & 448 Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(3)) then 449 449 cloudsat_pflag(i,pr) = pClass_Rain1 ! TSL: Rain possible 450 450 endif 451 if(cloudsat_precip_pia(i,pr) .gt.40) then451 if(cloudsat_precip_pia(i,pr)>40) then 452 452 cloudsat_pflag(i,pr) = pClass_Rain4 ! TSL: Heavy Rain 453 453 endif … … 455 455 456 456 ! No precipitation 457 if(Ze_non_out(i,pr,cloudsat_preclvl) .le.-15) then457 if(Ze_non_out(i,pr,cloudsat_preclvl)<=-15) then 458 458 cloudsat_pflag(i,pr) = pClass_noPrecip ! TSL: Not Raining 459 459 endif … … 463 463 ! 2b) Land points. 464 464 ! ################################################################################ 465 if (land(i) .eq.1) then465 if (land(i) == 1) then 466 466 ! Find Zmax, the maximum reflectivity value in the attenuated profile (Ze_out); 467 467 Zmax=maxval(Ze_out(i,pr,:)) 468 468 469 469 ! Snow (T<273) 470 if(t2m(i) .lt.273._wp) then471 if(Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(5)) then470 if(t2m(i) < 273._wp) then 471 if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(5)) then 472 472 cloudsat_pflag(i,pr) = pClass_Snow2 ! JEK: Snow certain 473 473 endif 474 if(Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(6) .and. &475 Ze_out(i,pr,cloudsat_preclvl) .le.Zbinvallnd(5)) then474 if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6) .and. & 475 Ze_out(i,pr,cloudsat_preclvl)<=Zbinvallnd(5)) then 476 476 cloudsat_pflag(i,pr) = pClass_Snow1 ! JEK: Snow possible 477 477 endif … … 479 479 480 480 ! Mized phase (273<T<275) 481 if(t2m(i) .ge. 273._wp .and. t2m(i) .le.275._wp) then482 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &483 (Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(4))) then481 if(t2m(i) >= 273._wp .and. t2m(i) <= 275._wp) then 482 if ((Zmax > Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr)>30) .or. & 483 (Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(4))) then 484 484 cloudsat_pflag(i,pr) = pClass_Mixed2 ! JEK: Mixed certain 485 485 endif 486 if ((Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(6) .and. &487 Ze_out(i,pr,cloudsat_preclvl) .le.Zbinvallnd(4)) .and. &488 (Zmax .gt.Zbinvallnd(5)) ) then486 if ((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6) .and. & 487 Ze_out(i,pr,cloudsat_preclvl) <= Zbinvallnd(4)) .and. & 488 (Zmax > Zbinvallnd(5)) ) then 489 489 cloudsat_pflag(i,pr) = pClass_Mixed1 ! JEK: Mixed possible 490 490 endif … … 492 492 493 493 ! Rain (T>275) 494 if(t2m(i) .gt.275) then495 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &496 (Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(2))) then494 if(t2m(i) > 275) then 495 if ((Zmax > Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr)>30) .or. & 496 (Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(2))) then 497 497 cloudsat_pflag(i,pr) = pClass_Rain3 ! JEK: Rain certain 498 498 endif 499 if((Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(6)) .and. &500 (Zmax .gt.Zbinvallnd(3))) then499 if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. & 500 (Zmax > Zbinvallnd(3))) then 501 501 cloudsat_pflag(i,pr) = pClass_Rain2 ! JEK: Rain probable 502 502 endif 503 if((Ze_out(i,pr,cloudsat_preclvl) .gt.Zbinvallnd(6)) .and. &504 (Zmax .lt.Zbinvallnd(3))) then503 if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. & 504 (Zmax<Zbinvallnd(3))) then 505 505 cloudsat_pflag(i,pr) = pClass_Rain1 ! JEK: Rain possible 506 506 endif 507 if(cloudsat_precip_pia(i,pr) .gt.40) then507 if(cloudsat_precip_pia(i,pr)>40) then 508 508 cloudsat_pflag(i,pr) = pClass_Rain4 ! JEK: Heavy Rain 509 509 endif … … 511 511 512 512 ! No precipitation 513 if(Ze_out(i,pr,cloudsat_preclvl) .le.-15) then513 if(Ze_out(i,pr,cloudsat_preclvl)<=-15) then 514 514 cloudsat_pflag(i,pr) = pClass_noPrecip ! JEK: Not Precipitating 515 515 endif … … 526 526 ! Gridmean precipitation fraction for each precipitation type 527 527 do k=1,nCloudsatPrecipClass 528 if (any(cloudsat_pflag(i,:) .eq.k-1)) then529 cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) .eq.k-1)528 if (any(cloudsat_pflag(i,:) == k-1)) then 529 cloudsat_precip_cover(i,k) = count(cloudsat_pflag(i,:) == k-1) 530 530 endif 531 531 enddo -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90
r3491 r5081 172 172 173 173 ! Compute effective radius from number concentration and distribution parameters 174 if (Re_internal .eq.0) then174 if (Re_internal == 0) then 175 175 call calc_Re(hm_matrix(pr,k,tp),Np_matrix(pr,k,tp),rho_a, & 176 176 sd%dtype(tp),sd%apm(tp),sd%bpm(tp),sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp),Re) … … 187 187 ! Index into particle size dimension of scaling tables 188 188 iRe_type=1 189 if(Re .gt.0) then189 if(Re>0) then 190 190 ! Determine index in to scale LUT 191 191 ! Distance between Re points (defined by "base" and "step") for … … 197 197 base = rcfg%base_list(n+1) 198 198 iRe_type=Re/step 199 if (iRe_type .lt.1) iRe_type=1199 if (iRe_type<1) iRe_type=1 200 200 Re=step*(iRe_type+0.5_wp) ! set value of Re to closest value allowed in LUT. 201 201 iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step) 202 202 203 203 ! Make sure iRe_type is within bounds 204 if (iRe_type .ge.nRe_types) then204 if (iRe_type>=nRe_types) then 205 205 !write(*,*) 'Warning: size of Re exceed value permitted ', & 206 206 ! 'in Look-Up Table (LUT). Will calculate. ' … … 405 405 ! Exponential is same as modified gamma with vu =1 406 406 ! if Np is specified then we will just treat as modified gamma 407 if(dtype .eq. 2 .and. Np .gt.0) then407 if(dtype == 2 .and. Np > 0) then 408 408 local_dtype = 1 409 409 local_p3 = 1 … … 441 441 endif 442 442 443 if( Np .eq.0 .and. p2+1 > 1E-8) then ! use default value for MEAN diameter as first default443 if( Np==0 .and. p2+1 > 1E-8) then ! use default value for MEAN diameter as first default 444 444 dm = p2 ! by definition, should have units of microns 445 445 D0 = gamma(vu)/gamma(vu+1)*dm 446 446 else ! use value of Np 447 if(Np .eq.0) then447 if(Np==0) then 448 448 if( abs(p1+1) > 1E-8 ) then ! use default number concentration 449 449 local_Np = p1 ! total number concentration / pa --- units kg^-1 … … 525 525 526 526 ! get rg ... 527 if( Np .eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg527 if( Np==0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg 528 528 rg = p2 529 529 else … … 826 826 log_sigma_g = p3 827 827 tmp2 = (bpm*log_sigma_g)*(bpm*log_sigma_g) 828 if(Re .le.0) then828 if(Re<=0) then 829 829 rg = p2 830 830 else -
LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90
r3491 r5081 75 75 76 76 ! Test for valid input overlap assumption 77 if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne.3) then77 if (overlap /= 1 .and. overlap /= 2 .and. overlap /= 3) then 78 78 overlap=default_overlap 79 79 call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)') … … 92 92 tca(1:npoints,1:nlev) = cc(1:npoints,1:nlev) 93 93 94 if (ncolprint .ne.0) then94 if (ncolprint/=0) then 95 95 write (6,'(a)') 'frac_out_pp_rev:' 96 96 do j=1,npoints,1000 … … 102 102 write (6,'(I3)') ncol 103 103 endif 104 if (ncolprint .ne.0) then104 if (ncolprint/=0) then 105 105 write (6,'(a)') 'last_frac_pp:' 106 106 do j=1,npoints,1000 … … 122 122 123 123 ! Initialise threshold 124 IF (ilev .eq.1) then124 IF (ilev==1) then 125 125 ! If max overlap 126 IF (overlap .eq.1) then126 IF (overlap==1) then 127 127 ! Select pixels spread evenly across the gridbox 128 128 threshold(1:npoints,1:ncol)=boxpos(1:npoints,1:ncol) … … 137 137 enddo 138 138 ENDIF 139 IF (ncolprint .ne.0) then139 IF (ncolprint/=0) then 140 140 write (6,'(a)') 'threshold_nsf2:' 141 141 do j=1,npoints,1000 … … 147 147 ENDIF 148 148 149 IF (ncolprint .ne.0) then149 IF (ncolprint/=0) then 150 150 write (6,'(a)') 'ilev:' 151 151 write (6,'(I2)') ilev … … 157 157 !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox)) 158 158 do j=1,npoints 159 if (boxpos(j,ibox) .le.conv(j,ilev)) then159 if (boxpos(j,ibox)<=conv(j,ilev)) then 160 160 maxocc(j,ibox) = 1 161 161 else … … 165 165 166 166 ! Max overlap 167 if (overlap .eq.1) then167 if (overlap==1) then 168 168 threshold_min(1:npoints,ibox) = conv(1:npoints,ilev) 169 169 maxosc(1:npoints,ibox) = 1 … … 171 171 172 172 ! Random overlap 173 if (overlap .eq.2) then173 if (overlap==2) then 174 174 threshold_min(1:npoints,ibox) = conv(1:npoints,ilev) 175 175 maxosc(1:npoints,ibox) = 0 176 176 endif 177 177 ! Max/Random overlap 178 if (overlap .eq.3) then178 if (overlap==3) then 179 179 ! DS2014 START: The bounds on tca are not valid when ilev=1. 180 180 !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev))) … … 182 182 ! min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. & 183 183 ! (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev))) 184 if (ilev .ne.1) then184 if (ilev /= 1) then 185 185 threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev))) 186 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt.&186 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < & 187 187 min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. & 188 (threshold(1:npoints,ibox) .gt.conv(1:npoints,ilev)))188 (threshold(1:npoints,ibox)>conv(1:npoints,ilev))) 189 189 else 190 190 threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(0._wp,tca(1:npoints,ilev))) 191 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) .lt.&191 maxosc(1:npoints,ibox) = merge(1,0,threshold(1:npoints,ibox) < & 192 192 min(0._wp,tca(1:npoints,ilev)) .and. & 193 (threshold(1:npoints,ibox) .gt.conv(1:npoints,ilev)))193 (threshold(1:npoints,ibox)>conv(1:npoints,ilev))) 194 194 endif 195 195 endif … … 205 205 206 206 ! Fill frac_out with 1's where tca is greater than the threshold 207 frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev) .gt.threshold(1:npoints,ibox))207 frac_out(1:npoints,ibox,ilev) = merge(1,0,tca(1:npoints,ilev)>threshold(1:npoints,ibox)) 208 208 209 209 ! Code to partition boxes into startiform and convective parts goes here 210 where(threshold(1:npoints,ibox) .le.conv(1:npoints,ilev) .and. conv(1:npoints,ilev).gt.0.) frac_out(1:npoints,ibox,ilev)=2210 where(threshold(1:npoints,ibox)<=conv(1:npoints,ilev) .and. conv(1:npoints,ilev)>0.) frac_out(1:npoints,ibox,ilev)=2 211 211 ENDDO ! ibox 212 212 213 213 214 214 ! Set last_frac to tca at this level, so as to be tca from last level next time round 215 if (ncolprint .ne.0) then215 if (ncolprint/=0) then 216 216 do j=1,npoints ,1000 217 217 write(6,'(a10)') 'j=' -
LMDZ6/branches/Amaury_dev/libf/phylmd/cv30param.h
r1992 r5081 20 20 real betad 21 21 22 COMMON /cv30param/ noff, minorig, nl, nlp, nlm & 23 , sigd, spfac & 22 COMMON /cv30param/ sigd, spfac & 24 23 !IM cf. FH : pour compatibilite avec conema3 TEMPORAIRE : ,pbcrit, ptcrit, epmax 25 24 ,pbcrit, ptcrit & 26 25 ,omtrain & 27 26 ,dtovsh, dpbase, dttrig & 28 ,dtcrit, tau, beta, alpha, delta, betad 27 ,dtcrit, tau, beta, alpha, delta, betad & 28 ,noff, minorig, nl, nlp, nlm 29 29 30 30 !$OMP THREADPRIVATE(/cv30param/) -
LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h
r3571 r5081 38 38 ,delta, betad & 39 39 ,ejectliq, ejectice & 40 ,flag_wb & 40 41 ,flag_epKEorig & 41 , flag_wb,cv_flag_feed &42 ,cv_flag_feed & 42 43 ,noff, minorig, nl, nlp, nlm 43 44 !$OMP THREADPRIVATE(/cv3param/) -
LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90
r4613 r5081 858 858 ! is assumed useless. 859 859 ! 860 compress = ncum .lt.len*comp_threshold860 compress = ncum < len*comp_threshold 861 861 ! 862 862 IF (.not. compress) THEN … … 1100 1100 Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue ' 1101 1101 DO k = 1,nd 1102 write (6, '(i4,5(1x,e13.6))') ,&1102 write (6, '(i4,5(1x,e13.6))') & 1103 1103 k, mp(igout,k), water(igout,k), ice(igout,k), & 1104 1104 evap(igout,k), fondue(igout,k) … … 1106 1106 Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM ' !!jygprl 1107 1107 DO k = 1,nd 1108 write (6, '(i4,3(1x,e13.6))') ,&1108 write (6, '(i4,3(1x,e13.6))') & 1109 1109 k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k) !!jygprl 1110 1110 ENDDO -
LMDZ6/branches/Amaury_dev/libf/phylmd/cvparam.h
r1992 r5081 21 21 real delta 22 22 23 COMMON /cvparam/ noff, minorig, nl, nlp, nlm & 24 ,elcrit, tlcrit & 23 COMMON /cvparam/ elcrit, tlcrit & 25 24 ,entp, sigs, sigd & 26 25 ,omtrain, omtsnow, coeffr, coeffs & 27 ,dtmax, cu, betad, alpha, damp, delta 26 ,dtmax, cu, betad, alpha, damp, delta & 27 ,noff, minorig, nl, nlp, nlm 28 28 29 29 !$OMP THREADPRIVATE(/cvparam/) -
LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h
r3780 r5081 15 15 real :: tg 16 16 17 common /flux_arp/fsens,flat, ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,betaevap,ok_forc_tsurf17 common /flux_arp/fsens,flat,betaevap,ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,ok_forc_tsurf 18 18 19 19 !$OMP THREADPRIVATE(/flux_arp/) -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90
r4812 r5081 3 3 IMPLICIT NONE 4 4 5 save 5 INTEGER :: lunout 6 6 7 integer :: lunout 7 INTEGER, PROTECTED :: nbsrf,is_lic,is_ter 8 REAL, PROTECTED :: RG,RV,RD,RCPD,RLSTT,RLVTT,RTT 9 REAL, PROTECTED :: a_ratqs_cv 10 REAL, PROTECTED :: tau_var 11 REAL, PROTECTED :: fac_tau 12 REAL, PROTECTED :: tau_cumul 13 REAL, PROTECTED :: a_ratqs_wake 14 INTEGER, PROTECTED :: dqimpl 8 15 9 INTEGER, SAVE, PROTECTED :: nbsrf,is_lic,is_ter 10 REAL, SAVE, PROTECTED :: RG,RV,RD,RCPD,RLSTT,RLVTT,RTT 11 REAL, SAVE, PROTECTED :: a_ratqs_cv 12 REAL, SAVE, PROTECTED :: tau_var 13 REAL, SAVE, PROTECTED :: fac_tau 14 REAL, SAVE, PROTECTED :: tau_cumul 15 REAL, SAVE, PROTECTED :: a_ratqs_wake 16 INTEGER, SAVE, PROTECTED :: dqimpl 17 18 real, allocatable, SAVE :: povariance(:,:) 16 REAL, ALLOCATABLE :: povariance(:,:) 19 17 !$OMP THREADPRIVATE(povariance) 20 real, allocatable, SAVE :: var_conv(:,:)18 REAL, ALLOCATABLE :: var_conv(:,:) 21 19 !$OMP THREADPRIVATE(var_conv) 22 20 … … 78 76 !-------------------------------------------------------- 79 77 80 if (klon .eq.1) then78 if (klon==1) then 81 79 do k=1,klev 82 80 do i=1,klon -
LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90
r4863 r5081 2 2 3 3 IMPLICIT NONE 4 5 save6 7 4 8 5 integer, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout -
LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol1.F90
r2003 r5081 190 190 IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',0,ZHOOK_HANDLE) 191 191 !--ajout OB 192 IF (K_LAYTROP .GT.100) THEN192 IF (K_LAYTROP>100) THEN 193 193 PRINT *,'ATTENTION KLAY_TROP > 100 PROBLEME ARRAY DANS RRTM ON ARRETE' 194 194 STOP -
LMDZ6/branches/Amaury_dev/libf/phylmd/tlift.F90
r2197 r5081 213 213 tvp(i) = tpk(i)*(1.+qsat_new/eps-rr(nk)) 214 214 ! jyg2 215 ELSE216 CONTINUE217 215 END IF 218 216 -
LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90
r4822 r5081 5 5 6 6 implicit none 7 8 save9 7 10 8 LOGICAL :: new_yamada4 -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90
r5051 r5081 297 297 END DO 298 298 299 if (fl_ebil .GT.0) then299 if (fl_ebil > 0) then 300 300 ! ------------------------------------------------ 301 301 ! Compute vertical sum for each atmospheric column … … 408 408 !===================================================================================== 409 409 410 IF (jbad .GT.0) THEN410 IF (jbad > 0) THEN 411 411 DO j = 1, jbad 412 412 i=jadrs(j) 413 if(prt_level .ge.debug_level) THEN413 if(prt_level>=debug_level) THEN 414 414 print*,'PLANTAGE POUR LE POINT i lon lat =',& 415 415 i,longitude_deg(i),latitude_deg(i),text … … 426 426 ! Impression, warning et correction en cas de probleme moins important 427 427 !===================================================================================== 428 IF (jqbad .GT.0) THEN428 IF (jqbad > 0) THEN 429 429 done(:) = .false. !jyg 430 430 DO j = 1, jqbad 431 431 i=jqadrs(j) 432 if(prt_level .ge.debug_level) THEN432 if(prt_level>=debug_level) THEN 433 433 print*,'WARNING : EAU POUR LE POINT i lon lat =',& 434 434 i,longitude_deg(i),latitude_deg(i),text … … 465 465 enddo 466 466 #endif 467 if(prt_level .ge.debug_level) THEN467 if(prt_level>=debug_level) THEN 468 468 print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', & 469 469 i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int … … 487 487 DO k = 1, klev 488 488 zq=q_seri(i,k)+zdq(i,k) 489 if (zq .lt.1.e-15) then490 if (q_seri(i,k) .lt.1.e-15) then491 if(prt_level .ge.debug_level) THEN489 if (zq<1.e-15) then 490 if (q_seri(i,k)<1.e-15) then 491 if(prt_level>=debug_level) THEN 492 492 print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k) 493 493 endif … … 555 555 ENDDO 556 556 ENDDO 557 IF (jbad .GT.0) THEN557 IF (jbad > 0) THEN 558 558 DO j = 1, jbad 559 559 i=jadrs(j) 560 560 k=kadrs(j) 561 if(prt_level .ge.debug_level) THEN561 if(prt_level>=debug_level) THEN 562 562 print*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',& 563 563 i,itap,longitude_deg(i),latitude_deg(i),text,jbad, & … … 573 573 ENDIF 574 574 ! 575 IF (jqbad .GT.0) THEN575 IF (jqbad > 0) THEN 576 576 DO j = 1, jqbad 577 577 i=jqadrs(j) 578 578 k=kqadrs(j) 579 if(prt_level .ge.debug_level) THEN579 if(prt_level>=debug_level) THEN 580 580 print*,'WARNING : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',& 581 581 i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,& … … 613 613 !====================================================================== 614 614 615 if (fl_ebil .GT.0) then615 if (fl_ebil > 0) then 616 616 617 617 ! ------------------------------------------------ … … 764 764 END DO 765 765 766 if (fl_ebil .GT.0) then766 if (fl_ebil > 0) then 767 767 ! ------------------------------------------------ 768 768 ! Compute vertical sum for each atmospheric column … … 795 795 !====================================================================== 796 796 797 if (fl_ebil .GT.0) then797 if (fl_ebil > 0) then 798 798 799 799 ! ------------------------------------------------ … … 944 944 945 945 !!print *,'prt_level:',prt_level,' fl_ebil:',fl_ebil,' fl_cor_ebil:',fl_cor_ebil 946 if ( (fl_ebil .GT. 0) .and. (klon .EQ.1)) then946 if ( (fl_ebil > 0) .and. (klon == 1)) then 947 947 948 948 bilq_bnd = 0. … … 976 976 bilh_error = d_h_col(1) - bilh_bnd 977 977 ! are the errors too large? 978 if ( abs(bilq_error) .gt.bilq_seuil) bilq_ok=1979 if ( abs(bilh_error) .gt.bilh_seuil) bilh_ok=1978 if ( abs(bilq_error) > bilq_seuil) bilq_ok=1 979 if ( abs(bilh_error) > bilh_seuil) bilh_ok=1 980 980 ! 981 981 ! Print diagnostics 982 982 ! ================= 983 if ( (bilq_ok .eq. 0).and.(bilh_ok .eq.0) ) then983 if ( (bilq_ok == 0).and.(bilh_ok == 0) ) then 984 984 status="enerbil-OK" 985 985 else … … 987 987 end if 988 988 989 if ( prt_level .GE.3) then989 if ( prt_level >= 3) then 990 990 write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error," H", bilh_error 991 991 9010 format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6) 992 992 end if 993 if ( prt_level .GE.3) then993 if ( prt_level >= 3) then 994 994 write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1) 995 995 end if 996 if ( prt_level .GE.5) then996 if ( prt_level >= 5) then 997 997 write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd 998 998 write(*,9000) text,"enerbil: water budget",d_qt_col(1),d_qw_col(1),d_ql_col(1),d_qs_col(1), d_qbs_col(1) … … 1002 1002 specific_diag: SELECT CASE (text) 1003 1003 CASE("vdf") specific_diag 1004 if ( prt_level .GE.5) then1004 if ( prt_level >= 5) then 1005 1005 write(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1) 1006 1006 write(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1) 1007 1007 end if 1008 1008 CASE("lsc") specific_diag 1009 if ( prt_level .GE.5) then1009 if ( prt_level >= 5) then 1010 1010 write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_lsc(1), rlvtt * rain_lsc(1), -(rcw-rcpd)*t_seri(1,1) * rain_lsc(1) 1011 1011 write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_lsc(1), rlstt * snow_lsc(1), -(rcs-rcpd)*t_seri(1,1) * snow_lsc(1) 1012 1012 end if 1013 1013 CASE("convection") specific_diag 1014 if ( prt_level .GE.5) then1014 if ( prt_level >= 5) then 1015 1015 write(*,9000) text,"enerbil: rain, bil_lat, bil_sens", rain_con(1), rlvtt * rain_con(1), -(rcw-rcpd)*t_seri(1,1) * rain_con(1) 1016 1016 write(*,9000) text,"enerbil: snow, bil_lat, bil_sens", snow_con(1), rlstt * snow_con(1), -(rcs-rcpd)*t_seri(1,1) * snow_con(1) -
LMDZ6/branches/Amaury_dev/libf/phylmdiso/physiq_mod.F90
r5075 r5081 6175 6175 itaprad = itaprad + 1 6176 6176 6177 IF (iflag_radia .eq.0) THEN6178 IF (prt_level .ge.9) THEN6177 IF (iflag_radia==0) THEN 6178 IF (prt_level>=9) THEN 6179 6179 PRINT *,'--------------------------------------------------' 6180 6180 PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas' … … 6258 6258 ! a l'echelle sous-maille: 6259 6259 ! 6260 IF (prt_level .GE.10) THEN6260 IF (prt_level >=10) THEN 6261 6261 print *,' call orography ? ', ok_orodr 6262 6262 ENDIF … … 6274 6274 ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to 6275 6275 ! earn computation time but they are not physical. 6276 IF (((zpic(i)-zmea(i)) .GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN6276 IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN 6277 6277 itest(i)=1 6278 6278 igwd=igwd+1 … … 6331 6331 ! such as ice sheets (work by V. Wiener) 6332 6332 zrel_oro(i)=zstd(i)/(max(zsig(i),1.E-8)*sqrt(cell_area(i))) 6333 IF (((zpic(i)-zmea(i)) .GT.zpmm_orolf_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN6333 IF (((zpic(i)-zmea(i))>zpmm_orolf_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN 6334 6334 itest(i)=1 6335 6335 igwd=igwd+1 … … 6555 6555 CALL getin_p('addtkeoro',addtkeoro) 6556 6556 6557 IF (prt_level .ge.5) &6557 IF (prt_level>=5) & 6558 6558 print*,'addtkeoro', addtkeoro 6559 6559 … … 6576 6576 ! 6577 6577 6578 IF (addtkeoro .GT.0 .AND. ok_orodr ) THEN6578 IF (addtkeoro > 0 .AND. ok_orodr ) THEN 6579 6579 ! ------------------------------------------- 6580 6580 … … 6583 6583 6584 6584 6585 IF (addtkeoro .EQ.1 ) THEN6585 IF (addtkeoro == 1 ) THEN 6586 6586 6587 6587 duadd(:,:)=alphatkeoro*d_u_oro(:,:) 6588 6588 dvadd(:,:)=alphatkeoro*d_v_oro(:,:) 6589 6589 6590 ELSE IF (addtkeoro .EQ.2) THEN6590 ELSE IF (addtkeoro == 2) THEN 6591 6591 6592 6592 IF (smallscales_tkeoro) THEN … … 6597 6597 ! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE 6598 6598 ! Mais attention, cela ne va pas dans le sens de la conservation de l'energie! 6599 IF ((zstd(i) .GT.1.0) .AND.(zrel_oro(i).LE.zrel_oro_t)) THEN6599 IF ((zstd(i)>1.0) .AND.(zrel_oro(i)<=zrel_oro_t)) THEN 6600 6600 itest(i)=1 6601 6601 igwd=igwd+1 … … 6609 6609 DO i=1,klon 6610 6610 itest(i)=0 6611 IF (((zpic(i)-zmea(i)) .GT.zpmm_orodr_t).AND.(zstd(i).GT.zstd_orodr_t).AND.(zrel_oro(i).LE.zrel_oro_t)) THEN6611 IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN 6612 6612 itest(i)=1 6613 6613 igwd=igwd+1 … … 6831 6831 IF (ok_airs) then 6832 6832 6833 IF (itap .eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN6833 IF (itap==1.or.MOD(itap,NINT(freq_airs/phys_tstep))==0) THEN 6834 6834 write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs 6835 6835 CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,& … … 6938 6938 IF (offline) THEN 6939 6939 6940 IF (prt_level .ge.9) &6940 IF (prt_level>=9) & 6941 6941 print*,'Attention on met a 0 les thermiques pour phystoke' 6942 6942 CALL phystokenc ( & … … 6959 6959 ! 6960 6960 !IM global posePB BEG 6961 IF(1 .EQ.0) THEN6961 IF(1==0) THEN 6962 6962 ! 6963 6963 CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, & … … 7118 7118 ! Convertir les incrementations en tendances 7119 7119 ! 7120 IF (prt_level .GE.10) THEN7120 IF (prt_level >=10) THEN 7121 7121 print *,'Convertir les incrementations en tendances ' 7122 7122 ENDIF … … 7141 7141 ENDIF 7142 7142 !--ice_sursat: nqo=4, on ajoute rneb 7143 IF (nqo .ge.4 .and. ok_ice_sursat) THEN7143 IF (nqo>=4 .and. ok_ice_sursat) THEN 7144 7144 d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep 7145 7145 ENDIF 7146 7146 7147 IF (nqo .ge.4 .and. ok_bs) THEN7147 IF (nqo>=4 .and. ok_bs) THEN 7148 7148 d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep 7149 7149 ENDIF … … 7216 7216 !========================================================================== 7217 7217 7218 IF (prt_level .ge.1) THEN7218 IF (prt_level>=1) THEN 7219 7219 write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!' 7220 7220 write(lunout,*) & -
LMDZ6/branches/Amaury_dev/tools/netcdf95/nf95_abort.f90
r5075 r5081 7 7 subroutine nf95_abort(message, ncerr, ncid, varid) 8 8 9 use, intrinsic:: iso_fortran_env 9 use, intrinsic:: iso_fortran_env, ONLY: error_unit 10 10 11 ! Libraries: 11 ! Libraries:mod_phys_lmdz_mpi_transfert 12 12 use lmdz_netcdf, only: nf90_strerror 13 13
Note: See TracChangeset
for help on using the changeset viewer.
