Changeset 5081


Ignore:
Timestamp:
Jul 19, 2024, 4:15:44 PM (7 weeks ago)
Author:
abarral
Message:

Commit linked to correcting relevant warnings during gfortran compilation

[minor]
Correct remnants of fixed-form "+" in massbarxy.F90
Correct COMMON alignment in clesphys.h, flux_arp.h, cv*param.h, YOECUMF.h, alpale.h
Correct obsolete logical operators
Restrict use of iso_fortran_env in nf95_abort.f90
Remove redundant save in module declarations
Remove <continue> without labels
Fix nonstandard kind selectors

Location:
LMDZ6/branches/Amaury_dev
Files:
41 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d/leapfrog.F

    r4143 r5081  
    301301      IF( purmats ) THEN
    302302      ! 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 )
    305305     s        apdiss = .TRUE.
    306          IF( MOD(itau,iphysiq ).EQ.0.AND..NOT.forward
     306         IF( MOD(itau,iphysiq )==0.AND..NOT.forward
    307307     s          .and. physic                        ) apphys = .TRUE.
    308308      ELSE
    309309      ! 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 )
    312312     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.
    314314      END IF
    315315
    316316! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
    317317!          supress dissipation step
    318       if (llm.eq.1) then
     318      if (llm==1) then
    319319        apdiss=.false.
    320320      endif
    … …  
    387387c
    388388       IF( purmats )  THEN
    389           IF( itau.EQ.itaufin.AND..NOT.forward ) lafin = .TRUE.
     389          IF( itau==itaufin.AND..NOT.forward ) lafin = .TRUE.
    390390       ELSE
    391391          IF( itau+1. EQ. itaufin )              lafin = .TRUE.
    … …  
    418418     &          (itau+1)/day_step
    419419
    420            IF (planet_type .eq."generic") THEN
     420           IF (planet_type =="generic") THEN
    421421              ! AS: we make jD_cur to be pday
    422422              jD_cur = int(day_ini + itau/day_step)
    … …  
    441441
    442442c  Diagnostique de conservation de l'energie : initialisation
    443          IF (ip_ebil_dyn.ge.1 ) THEN
     443         IF (ip_ebil_dyn>=1 ) THEN
    444444          ztit='bil dyn'
    445445! Ehouarn: be careful, diagedyn is Earth-specific!
    446            IF (planet_type.eq."earth") THEN
     446           IF (planet_type=="earth") THEN
    447447            CALL diagedyn(ztit,2,1,1,dtphys
    448448     &    , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    … …  
    488488c
    489489c  Diagnostique de conservation de l'energie : difference
    490          IF (ip_ebil_dyn.ge.1 ) THEN
     490         IF (ip_ebil_dyn>=1 ) THEN
    491491          ztit='bil phys'
    492           IF (planet_type.eq."earth") THEN
     492          IF (planet_type=="earth") THEN
    493493           CALL diagedyn(ztit,2,1,1,dtphys
    494494     &     , ucov    , vcov , ps, p ,pk , teta , q(:,:,1), q(:,:,2))
    … …  
    498498       ENDIF ! of IF( apphys )
    499499
    500       IF(iflag_phys.EQ.2) THEN ! "Newtonian" case
     500      IF(iflag_phys==2) THEN ! "Newtonian" case
    501501!   Academic case : Simple friction and Newtonan relaxation
    502502!   -------------------------------------------------------
    … …  
    508508        ENDDO ! of DO l=1,llm
    509509       
    510         if (planet_type.eq."giant") then
     510        if (planet_type=="giant") then
    511511          ! add an intrinsic heat flux at the base of the atmosphere
    512512          teta(:,1)=teta(:,1)+dtvr*aire(:)*ihf/cpp/masse(:,1)
    … …  
    663663c   -------------------------------------
    664664
    665             IF(MOD(itau,iperiod).EQ.0 .OR. itau.EQ.itaufin) THEN
    666                IF(itau.EQ.itaufin) THEN
     665            IF(MOD(itau,iperiod)==0 .OR. itau==itaufin) THEN
     666               IF(itau==itaufin) THEN
    667667                  iav=1
    668668               ELSE
    … …  
    694694c   ------------------------------
    695695
    696             IF( MOD(itau,iecri).EQ.0) THEN
     696            IF( MOD(itau,iecri)==0) THEN
    697697             ! Ehouarn: output only during LF or Backward Matsuno
    698698             if (leapf.or.(.not.leapf.and.(.not.forward))) then
    … …  
    721721            ENDIF ! of IF(MOD(itau,iecri).EQ.0)
    722722
    723             IF(itau.EQ.itaufin) THEN
     723            IF(itau==itaufin) THEN
    724724
    725725
    … …  
    743743c   ------------------------------------
    744744
    745             IF( MOD(itau,iperiod).EQ.0 )    THEN
     745            IF( MOD(itau,iperiod)==0 )    THEN
    746746                    GO TO 1
    747747            ELSE IF ( MOD(itau-1,iperiod). EQ. 0 ) THEN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limy.F

    r2603 r5081  
    150150c      enddo
    151151
    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.)
    153153     &   then
    154154         do ij=1,iip1
    … …  
    162162
    163163      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.)
    165165     &then
    166166         do ij=ip1jm+1,ip1jmp1
    … …  
    175175c   calcul des pentes limitees
    176176
    177       do ij=1,ip1jmp1
    178          if(dyqv(ij)*dyqv(ij-iip1).gt.0.) then
     177      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
    179179            dyq(ij)=sign(min(abs(dyq(ij)),dyqmax(ij)),dyq(ij))
    180180         else

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/massbarxy.F90

    r2597 r5081  
    2121    DO ij=1,ip1jm-1
    2222      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)
    2626    END DO
    2727    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  
    15981598    if (first) then
    15991599         ncidpl=-99
    1600          write(*,*),trim(modname)//': opening nudging files '
     1600         write(*,*) trim(modname)//': opening nudging files '
    16011601! Ap et Bp si Niveaux de pression hybrides
    16021602         if (guide_plevs==1) then
    1603              write(*,*),trim(modname)//' Reading nudging on model levels'
     1603             write(*,*) trim(modname)//' Reading nudging on model levels'
    16041604             rcode = nf90_open('apbp.nc', nf90_nowrite, ncidpl)
    16051605             IF (rcode/=NF_NOERR) THEN
    … …  
    16171617              CALL abort_gcm(modname,abort_message,1)
    16181618             ENDIF
    1619              write(*,*),trim(modname)//' ncidpl,varidap',ncidpl,varidap
     1619             write(*,*) trim(modname)//' ncidpl,varidap',ncidpl,varidap
    16201620         endif
    16211621         
    … …  
    16321632              CALL abort_gcm(modname,abort_message,1)
    16331633             ENDIF
    1634              write(*,*),trim(modname)//' ncidp,varidp',ncidp,varidp
     1634             write(*,*) trim(modname)//' ncidp,varidp',ncidp,varidp
    16351635             if (ncidpl==-99) ncidpl=ncidp
    16361636         endif
    … …  
    16481648              CALL abort_gcm(modname,abort_message,1)
    16491649             ENDIF
    1650              write(*,*),trim(modname)//' ncidu,varidu',ncidu,varidu
     1650             write(*,*) trim(modname)//' ncidu,varidu',ncidu,varidu
    16511651             if (ncidpl==-99) ncidpl=ncidu
    16521652
    … …  
    16801680              CALL abort_gcm(modname,abort_message,1)
    16811681             ENDIF
    1682              write(*,*),trim(modname)//' ncidv,varidv',ncidv,varidv
     1682             write(*,*) trim(modname)//' ncidv,varidv',ncidv,varidv
    16831683             if (ncidpl==-99) ncidpl=ncidv
    16841684             
    … …  
    17131713              CALL abort_gcm(modname,abort_message,1)
    17141714             ENDIF
    1715              write(*,*),trim(modname)//' ncidT,varidT',ncidt,varidt
     1715             write(*,*) trim(modname)//' ncidT,varidT',ncidt,varidt
    17161716             if (ncidpl==-99) ncidpl=ncidt
    17171717
    … …  
    17441744              CALL abort_gcm(modname,abort_message,1)
    17451745             ENDIF
    1746              write(*,*),trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
     1746             write(*,*) trim(modname)//' ncidQ,varidQ',ncidQ,varidQ
    17471747             if (ncidpl==-99) ncidpl=ncidQ
    17481748
    … …  
    17761776              CALL abort_gcm(modname,abort_message,1)
    17771777             ENDIF
    1778              write(*,*),trim(modname)//' ncidps,varidps',ncidps,varidps
     1778             write(*,*) trim(modname)//' ncidps,varidps',ncidps,varidps
    17791779         endif
    17801780! Coordonnee verticale
    … …  
    17821782              rcode = nf90_inq_varid(ncidpl, 'LEVEL', varidpl)
    17831783              IF (rcode/=0) rcode = nf90_inq_varid(ncidpl, 'PRESSURE', varidpl)
    1784               write(*,*),trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
     1784              write(*,*) trim(modname)//' ncidpl,varidpl',ncidpl,varidpl
    17851785         endif
    17861786! Coefs ap, bp pour calcul de la pression aux differents niveaux

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/massbarxy_loc.F90

    r2597 r5081  
    2727    DO ij=ijb,ije-1
    2828      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)
    3232    END DO
    3333    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  
    6262      if (pole_sud.and.ije==ip1jmp1)  ije=ije-iip1
    6363     
    64       IF (pente_max.gt.-1.e-5) THEN
     64      IF (pente_max>-1.e-5) THEN
    6565c     IF (pente_max.gt.10) THEN
    6666
    … …  
    104104     ,         cvmgp(dxqu(ij-1)+dxqu(ij),0.,dxqu(ij-1)*dxqu(ij))
    105105#else
    106                IF(dxqu(ij-1)*dxqu(ij).gt.0) THEN
     106               IF(dxqu(ij-1)*dxqu(ij)>0) THEN
    107107                  dxq(ij,l)=dxqu(ij-1)+dxqu(ij)
    108108               ELSE
    … …  
    135135               zz(ij)=dxqu(ij-1)*dxqu(ij)
    136136               zz(ij)=zz(ij)+zz(ij)
    137                IF(zz(ij).gt.0) THEN
     137               IF(zz(ij)>0) THEN
    138138                  dxq(ij,l)=zz(ij)/(dxqu(ij-1)+dxqu(ij))
    139139               ELSE
    … …  
    205205      DO l=1,llm
    206206       DO ij=ijb,ije-1
    207           IF (u_m(ij,l).gt.0.) THEN
     207          IF (u_m(ij,l)>0.) THEN
    208208             zdum(ij,l)=1.-u_m(ij,l)/masse(ij,l,iq)
    209209             u_mq(ij,l)=u_m(ij,l)*
    … …  
    225225      DO l=1,llm
    226226         DO ij=ijb,ije-1
    227             IF(zdum(ij,l).lt.0) THEN
     227            IF(zdum(ij,l)<0) THEN
    228228               iadvplus(ij,l)=1
    229229               u_mq(ij,l)=0.
    … …  
    269269c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    270270         DO l=1,llm
    271             IF(nl(l).gt.0) THEN
     271            IF(nl(l)>0) THEN
    272272               iju=0
    273273c   indicage des mailles concernees par le traitement special
    274274               DO ij=ijb,ije
    275                   IF(iadvplus(ij,l).eq.1.and.mod(ij,iip1).ne.0) THEN
     275                  IF(iadvplus(ij,l)==1.and.mod(ij,iip1)/=0) THEN
    276276                     iju=iju+1
    277277                     indu(iju)=ij
    … …  
    287287                  zu_m=u_m(ij,l)
    288288                  u_mq(ij,l)=0.
    289                   IF(zu_m.gt.0.) THEN
     289                  IF(zu_m>0.) THEN
    290290                     ijq=ij
    291291                     i=ijq-(j-1)*iip1
    292292c   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))
    294294                        u_mq(ij,l)=u_mq(ij,l)+q(ijq,l,iq)
    295295     &                     *masse(ijq,l,iq)
    … …  
    305305                     i=ijq-(j-1)*iip1
    306306c   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))
    308308                        u_mq(ij,l)=u_mq(ij,l)-q(ijq,l,iq)
    309309     &                   *masse(ijq,l,iq)
    … …  
    345345            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    346346            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 2020
     347            if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
    348348              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    349349            else
    … …  
    478478      ij=3525
    479479      l=3
    480       if ((ij.ge.ijb).and.(ij.le.ije)) then
     480      if ((ij>=ijb).and.(ij<=ije)) then
    481481        !write(*,*) 'vlyqs 480: ij,l,iq,ijb,q(ij,l,:)=',
    482482!     &             ij,l,iq,ijb,q(ij,l,:)
    … …  
    576576        fn=1.
    577577        DO ij=1,iim
    578           IF(pente_max*adyqv(ij).lt.abs(dyq(ij,l))) THEN
     578          IF(pente_max*adyqv(ij)<abs(dyq(ij,l))) THEN
    579579            fn=min(pente_max*adyqv(ij)/abs(dyq(ij,l)),fn)
    580580          ENDIF
    … …  
    608608        fs=1.
    609609        DO ij=1,iim
    610         IF(pente_max*adyqv(ij+ip1jm-iip1).lt.abs(dyq(ij+ip1jm,l))) THEN
     610        IF(pente_max*adyqv(ij+ip1jm-iip1)<abs(dyq(ij+ip1jm,l))) THEN
    611611         fs=min(pente_max*adyqv(ij+ip1jm-iip1)/abs(dyq(ij+ip1jm,l)),fs)
    612612        ENDIF
    … …  
    694694
    695695      DO ij=ijb,ije
    696          IF(dyqv(ij)*dyqv(ij-iip1).gt.0.) THEN
     696         IF(dyqv(ij)*dyqv(ij-iip1)>0.) THEN
    697697            dyq(ij,l)=sign(min(abs(dyq(ij,l)),dyqmax(ij)),dyq(ij,l))
    698698         ELSE
    … …  
    712712      DO l=1,llm
    713713       DO ij=ijb,ije
    714          IF( masse_adv_v(ij,l).GT.0. ) THEN
     714         IF( masse_adv_v(ij,l)>0. ) THEN
    715715           qbyv(ij,l,iq)= MIN( qsat(ij+iip1,l), q(ij+iip1,l,iq )  +
    716716     ,      dyq(ij+iip1,l)*0.5*(1.-masse_adv_v(ij,l)
    … …  
    757757            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    758758            !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 2020
     759            if (q(ij,l,iq)>min_qParent) then ! modif 13 nov 2020
    760760              Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    761761            else
    … …  
    806806         IF (pole_sud) THEN
    807807         
    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 ???
    809809           convmps = -SSUM(iim,masse_adv_v(ip1jm-iim,l),1)/apols
    810810           DO ij = ip1jm+1,ip1jmp1

  • LMDZ6/branches/Amaury_dev/libf/misc/cray.F

    r1907 r5081  
    1515      iy=1
    1616      ix=1
    17       do 10 i=1,n
     17      DO i=1,n
    1818         sy(iy)=sx(ix)
    1919         ix=ix+incx
    2020         iy=iy+incy
    21 10    continue
     21      END DO
    2222c
    2323      return
    … …  
    3333      ssum=0.
    3434      ix=1
    35       do 10 i=1,n
     35      do i=1,n
    3636         ssum=ssum+sx(ix)
    3737         ix=ix+incx
    38 10    continue
     38      end do
    3939c
    4040      return

  • LMDZ6/branches/Amaury_dev/libf/phy_common/mod_phys_lmdz_mpi_transfert.F90

    r4600 r5081  
    6565!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    6666
    67 !! -- Les chaine de charactère -- !!
     67!! -- Les chaine de charact�re -- !!
    6868
    6969  SUBROUTINE bcast_mpi_c(var1)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/StratAer/cond_evap_tstep_mod.F90

    r4950 r5081  
    227227!     H2SO4 mass fraction in aerosol
    228228      WH2=R2SO4*1.0E-2
    229       IF(WH2.EQ.0.0) RETURN
     229      IF(WH2==0.0) RETURN
    230230!                               ACTIVITY COEFFICIENT(SEE GIAUQUE,1951)
    231231!                               AYERS ET AL (1980)
    … …  
    324324        ff(IK,:)=0.0
    325325        DO k=1, nbtr_bin
    326           IF (k.LE.(nbtr_bin-1)) THEN
    327             IF (Vbin_wet(k).LE.Vnew.AND.Vnew.LT.Vbin_wet(k+1)) THEN
     326          IF (k<=(nbtr_bin-1)) THEN
     327            IF (Vbin_wet(k)<=Vnew.AND.Vnew<Vbin_wet(k+1)) THEN
    328328              ff(IK,k)= Vbin_wet(k)/Vnew*(Vbin_wet(k+1)-Vnew)/(Vbin_wet(k+1)-Vbin_wet(k))
    329329            ENDIF
    330330          ENDIF
    331           IF (k.EQ.1.AND.Vnew.LE.Vbin_wet(k)) THEN
     331          IF (k==1.AND.Vnew<=Vbin_wet(k)) THEN
    332332            ff(IK,k)= 1.
    333333          ENDIF
    334           IF (k.GT.1) THEN
    335             IF (Vbin_wet(k-1).LT.Vnew.AND.Vnew.LT.Vbin_wet(k)) THEN
     334          IF (k>1) THEN
     335            IF (Vbin_wet(k-1)<Vnew.AND.Vnew<Vbin_wet(k)) THEN
    336336              ff(IK,k)= 1.-ff(IK,k-1)
    337337            ENDIF
    338338          ENDIF
    339           IF (k.EQ.nbtr_bin.AND.Vnew.GE.Vbin_wet(k)) THEN
     339          IF (k==nbtr_bin.AND.Vnew>=Vbin_wet(k)) THEN
    340340            ff(IK,k)= 1.
    341341          ENDIF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/YOECUMF.h

    r1907 r5081  
    1212!
    1313      COMMON /YOECUMF/                                                  &
    14      &                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV,              &
    1514     &                 ENTRPEN,ENTRSCV,ENTRMID,ENTRDD,CMFCTOP,          &
    16      &                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON
     15     &                 CMFCMAX,CMFCMIN,CMFDEPS,RHCDD,CPRCON,            &
     16     &                 LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV
     17
    1718
    1819      LOGICAL          LMFPEN,LMFSCV,LMFMID,LMFDD,LMFDUDV

  • LMDZ6/branches/Amaury_dev/libf/phylmd/aaam_bud.F90

    r2350 r5081  
    127127  hadley = 1.E18
    128128  hadday = 1.E18*24.*3600.
    129   IF(klon_glo.EQ.1) THEN
     129  IF(klon_glo==1) THEN
    130130    dlat = xpi
    131131  ELSE

  • LMDZ6/branches/Amaury_dev/libf/phylmd/acama_gwd_rando_m.F90

    r3977 r5081  
    358358         CMAX*2.*(MOD(TT(II, JW+4*(JJ-1)+JJ)**2, 1.)-0.5)*SQRT(3.)/SQRT(NA*1.)
    359359                END DO
    360                 IF (CPHA.LT.0.)  THEN
     360                IF (CPHA<0.)  THEN
    361361                   CPHA = -1.*CPHA
    362362                   ZP(JW,II) = ZP(JW,II) + RPI

  • LMDZ6/branches/Amaury_dev/libf/phylmd/add_phys_tend_mod.F90

    r5051 r5081  
    226226  ENDDO
    227227
    228   IF (fl_ebil .GT. 0) THEN
     228  IF (fl_ebil > 0) THEN
    229229    ! ------------------------------------------------
    230230    ! Compute vertical sum for each atmospheric column
    … …  
    283283!=====================================================================================
    284284
    285   IF (jbad .GT. 0) THEN
     285  IF (jbad > 0) THEN
    286286     DO j = 1, jbad
    287287        i=jadrs(j)
    288         IF (prt_level.ge.debug_level) THEN
     288        IF (prt_level>=debug_level) THEN
    289289          print*,'PLANTAGE POUR LE POINT i lon lat =',&
    290290                 i,longitude_deg(i),latitude_deg(i),text
    … …  
    301301! Impression, warning et correction en cas de probleme moins important
    302302!=====================================================================================
    303   IF (jqbad .GT. 0) THEN
     303  IF (jqbad > 0) THEN
    304304      done(:) = .false.                         !jyg
    305305      DO j = 1, jqbad
    306306        i=jqadrs(j)
    307           if(prt_level.ge.debug_level) THEN
     307          if(prt_level>=debug_level) THEN
    308308           print*,'WARNING  : EAU POUR LE POINT i lon lat =',&
    309309                  i,longitude_deg(i),latitude_deg(i),text
    … …  
    325325                zqp_int = zqp_int + zqp(k)     *(paprs(i,k)-paprs(i,k+1))/Rg
    326326              ENDDO
    327               IF (prt_level.ge.debug_level) THEN
     327              IF (prt_level>=debug_level) THEN
    328328               print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
    329329                                    i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
    … …  
    340340            DO k = 1, klev
    341341              zq=q_seri(i,k)+zdq(i,k)
    342               IF (zq.lt.1.e-15) THEN
    343                  IF (q_seri(i,k).lt.1.e-15) THEN
    344                    IF (prt_level.ge.debug_level) THEN
     342              IF (zq<1.e-15) THEN
     343                 IF (q_seri(i,k)<1.e-15) THEN
     344                   IF (prt_level>=debug_level) THEN
    345345                    print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
    346346                   ENDIF
    … …  
    383383     ENDDO
    384384  ENDDO
    385   IF (jbad .GT. 0) THEN
     385  IF (jbad > 0) THEN
    386386      DO j = 1, jbad
    387387         i=jadrs(j)
    388388         k=kadrs(j)
    389          if(prt_level.ge.debug_level) THEN
     389         if(prt_level>=debug_level) THEN
    390390          print*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',&
    391391                 i,itap,longitude_deg(i),latitude_deg(i),text,jbad, &
    … …  
    401401  ENDIF
    402402!
    403   IF (jqbad .GT. 0) THEN
     403  IF (jqbad > 0) THEN
    404404      DO j = 1, jqbad
    405405         i=jqadrs(j)
    406406         k=kqadrs(j)
    407          IF (prt_level.ge.debug_level) THEN
     407         IF (prt_level>=debug_level) THEN
    408408          print*,'WARNING  : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',&
    409409                 i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,&
    … …  
    441441!======================================================================
    442442
    443   IF (fl_ebil .GT. 0) THEn
     443  IF (fl_ebil > 0) THEn
    444444 
    445445    ! ------------------------------------------------
    … …  
    584584  ENDDO
    585585
    586   IF (fl_ebil .GT. 0) THEN
     586  IF (fl_ebil > 0) THEN
    587587    ! ------------------------------------------------
    588588    ! Compute vertical sum for each atmospheric column
    … …  
    613613!======================================================================
    614614
    615   IF (fl_ebil .GT. 0) THEN
     615  IF (fl_ebil > 0) THEN
    616616 
    617617    ! ------------------------------------------------
    … …  
    761761
    762762!!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)) THEN
     763IF ((fl_ebil > 0) .AND. (klon == 1)) THEN
    764764
    765765  bilq_bnd = 0.
    … …  
    793793  bilh_error = d_h_col(1) - bilh_bnd
    794794! are the errors too large?
    795   IF (abs(bilq_error) .GT. bilq_seuil) bilq_ok=1
    796   IF (abs(bilh_error) .GT. bilh_seuil) bilh_ok=1
     795  IF (abs(bilq_error) > bilq_seuil) bilq_ok=1
     796  IF (abs(bilh_error) > bilh_seuil) bilh_ok=1
    797797!
    798798! Print diagnostics
    799799! =================
    800   IF ( (bilq_ok .eq. 0).AND.(bilh_ok .eq. 0) ) THEN
     800  IF ( (bilq_ok == 0).AND.(bilh_ok == 0) ) THEN
    801801    status="enerbil-OK"
    802802  ELSE
    … …  
    804804  ENDIF
    805805
    806   IF (prt_level .GE. 3) THEN
     806  IF (prt_level >= 3) THEN
    807807    write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
    8088089010  format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6)
    809809  ENDIF
    810   IF (prt_level .GE. 3) THEN
     810  IF (prt_level >= 3) THEN
    811811    write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
    812812  ENDIF
    813   IF (prt_level .GE. 5) THEN
     813  IF (prt_level >= 5) THEN
    814814    write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd
    815815    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)
    … …  
    819819  specific_diag: SELECT CASE (text)
    820820  CASE("vdf") specific_diag
    821     IF (prt_level .GE. 5) THEN
     821    IF (prt_level >= 5) THEN
    822822      write(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1)
    823823      write(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1)
    824824    ENDIF
    825825  CASE("lsc") specific_diag
    826     IF (prt_level .GE. 5) THEN
     826    IF (prt_level >= 5) THEN
    827827      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)
    828828      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)
    829829    ENDIF
    830830  CASE("convection") specific_diag
    831     IF (prt_level .GE. 5) THEN
     831    IF (prt_level >= 5) THEN
    832832      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)
    833833      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  
    11SUBROUTINE add_wake_tend(zddeltat, zddeltaq, zds, zdas, zddensw, zddensaw, zoccur, text, abortphy)
    22!===================================================================
    3 ! Ajoute les tendances liées aux diverses parametrisations physiques aux
     3! Ajoute les tendances li�es aux diverses parametrisations physiques aux
    44! variables d'etat des poches froides.
    55!===================================================================
    … …  
    4343         DO l = 1, klev
    4444           DO i = 1, klon
    45              IF (zoccur(i) .GE. 1) THEN
     45             IF (zoccur(i) >= 1) THEN
    4646               wake_deltat(i, l) = wake_deltat(i, l) + zddeltat(i,l)
    4747               wake_deltaq(i, l) = wake_deltaq(i, l) + zddeltaq(i,l)
    … …  
    5353         END DO
    5454         DO i = 1, klon
    55            IF (zoccur(i) .GE. 1) THEN
     55           IF (zoccur(i) >= 1) THEN
    5656             wake_s(i)     = wake_s(i)    + zds(i)
    5757             awake_s(i)    = awake_s(i)    + zdas(i)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/alpale.h

    r4843 r5081  
    1414
    1515      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_trig
     16      common/calpale2/alp_bl_k,s_trig,h_trig,iflag_coupl,iflag_clos,iflag_wake
    1717
    1818!$OMP THREADPRIVATE(/calpale1/,/calpale2/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_wk.F90

    r3068 r5081  
    5858!!  print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1)
    5959  DO i = 1,klon
    60     IF (zoccur(i) .GE. 1) THEN
     60    IF (zoccur(i) >= 1) THEN
    6161      wkrad(i) = sqrt(sigmaw(i)/(rpi*wdens(i)))
    6262    ELSE

  • LMDZ6/branches/Amaury_dev/libf/phylmd/clesphys.h

    r5017 r5081  
    133133     &     , qsol0,albsno0,evap0                                        &
    134134     &     , co2_ppm0                                                   &
     135     &     , tau_thermals                                               &
    135136!FC
    136137     &     , Cd_frein,zrel_oro_t,zpmm_orodr_t,zpmm_orolf_t,zstd_orodr_t &
    … …  
    163164     &     , ok_daily_climoz, ok_all_xml, ok_lwoff                      &
    164165     &     , iflag_phytrac, ok_new_lscp, ok_bs, ok_rad_bs               &
    165      &     ,  iflag_thermals,nsplit_thermals, tau_thermals              &
     166     &     ,  iflag_thermals,nsplit_thermals              &
    166167     &     , iflag_physiq, ok_3Deffect, ok_water_mass_fixer
    167168       save /clesphys/

  • LMDZ6/branches/Amaury_dev/libf/phylmd/climb_hq_mod.F90

    r3102 r5081  
    77
    88  IMPLICIT NONE
    9   SAVE
    109  PRIVATE
    1110  PUBLIC :: climb_hq_down, climb_hq_up, d_h_col_vdf, f_h_bnd
    … …  
    222221!!! jyg le 07/02/2012
    223222!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
    224        IF (mod(iflag_pbl_split,10) .ge.1) THEN
     223       IF (mod(iflag_pbl_split,10) >=1) THEN
    225224!!! nrlmd le 02/05/2011
    226225    DO k= 1, klev
    … …  
    231230        Dcoef_Q_out(i,k) = Dcoef_Q(i,k)
    232231        Kcoef_hq_out(i,k) = Kcoefhq(i,k)
    233           IF (k.eq.1) THEN
     232          IF (k==1) THEN
    234233            gama_h_out(i,k)  = 0.
    235234            gama_q_out(i,k)  = 0.
    … …  
    379378!!! jyg le 07/02/2012
    380379!!jyg       IF (mod(iflag_pbl_split,2) .eq.1) THEN
    381        IF (mod(iflag_pbl_split,10) .ge.1) THEN
     380       IF (mod(iflag_pbl_split,10) >=1) THEN
    382381!!! nrlmd le 02/05/2011
    383382    DO i = 1, knon
    … …  
    394393        Dcoef_Q(i,k)=Dcoef_Q_in(i,k)
    395394        Kcoefhq(i,k)=Kcoef_hq_in(i,k)
    396           IF (k.gt.1) THEN
     395          IF (k>1) THEN
    397396            gamah(i,k)=gama_h_in(i,k)
    398397            gamaq(i,k)=gama_q_in(i,k)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/conf_phys_m.F90

    r4843 r5081  
    13521352    !Config Help =
    13531353    !
    1354     ok_ice_sursat_omp = 0
     1354    ok_ice_sursat_omp = .FALSE.
    13551355    CALL getin('ok_ice_sursat',ok_ice_sursat_omp)
    13561356
    … …  
    25742574
    25752575    !--test on radiative scheme
    2576     IF (iflag_rrtm .EQ. 0) THEN
    2577       IF (NSW.NE.2) THEN
     2576    IF (iflag_rrtm == 0) THEN
     2577      IF (NSW/=2) THEN
    25782578        WRITE(lunout,*) ' ERROR iflag_rrtm=0 and NSW<>2 not possible'
    25792579        CALL abort_physic('conf_phys','choice NSW not valid',1)
    25802580      ENDIF
    2581     ELSE IF (iflag_rrtm .EQ. 1) THEN
    2582       IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
     2581    ELSE IF (iflag_rrtm == 1) THEN
     2582      IF (NSW/=2.AND.NSW/=4.AND.NSW/=6) THEN
    25832583        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
    25842584        CALL abort_physic('conf_phys','choice NSW not valid',1)
    25852585      ENDIF
    2586    ELSE IF (iflag_rrtm .EQ. 2) THEN
    2587       IF (NSW.NE.2.AND.NSW.NE.4.AND.NSW.NE.6) THEN
     2586   ELSE IF (iflag_rrtm == 2) THEN
     2587      IF (NSW/=2.AND.NSW/=4.AND.NSW/=6) THEN
    25882588        WRITE(lunout,*) ' ERROR iflag_rrtm=1 and NSW<>2,4,6 not possible'
    25892589        CALL abort_physic('conf_phys','choice NSW not valid',1)
    … …  
    26102610
    26112611    !--test on ocean surface albedo
    2612     IF (iflag_albedo.LT.0.OR.iflag_albedo.GT.2) THEN
     2612    IF (iflag_albedo<0.OR.iflag_albedo>2) THEN
    26132613       WRITE(lunout,*) ' ERROR iflag_albedo<>0,1'
    26142614       CALL abort_physic('conf_phys','choice iflag_albedo not valid',1)
    … …  
    26172617    ! Flag_aerosol cannot be set to zero if aerosol direct effect (ade) or aerosol indirect effect (aie) are activated
    26182618    IF (ok_ade .OR. ok_aie) THEN
    2619        IF ( flag_aerosol .EQ. 0 ) THEN
     2619       IF ( flag_aerosol == 0 ) THEN
    26202620          CALL abort_physic('conf_phys','flag_aerosol=0 not compatible avec ok_ade ou ok_aie=.TRUE.',1)
    26212621       ENDIF
    … …  
    26232623
    26242624    ! Flag_aerosol cannot be set to zero if we are in coupled mode for aerosol
    2625     IF (aerosol_couple .AND. flag_aerosol .EQ. 0 ) THEN
     2625    IF (aerosol_couple .AND. flag_aerosol == 0 ) THEN
    26262626       CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if aerosol_couple=y ', 1)
    26272627    ENDIF
    26282628
    26292629    ! Read_climoz needs to be set zero if we are in couple mode for chemistry
    2630     IF (chemistry_couple .AND. read_climoz .ne. 0) THEN
     2630    IF (chemistry_couple .AND. read_climoz /= 0) THEN
    26312631       CALL abort_physic('conf_phys', 'read_climoz need to be to zero if chemistry_couple=y ', 1)
    26322632    ENDIF
    26332633
    26342634    ! flag_aerosol need to be different to zero if ok_cdnc is activated
    2635     IF (ok_cdnc .AND. flag_aerosol .EQ. 0) THEN
     2635    IF (ok_cdnc .AND. flag_aerosol == 0) THEN
    26362636       CALL abort_physic('conf_phys', 'flag_aerosol cannot be to zero if ok_cdnc is activated ', 1)
    26372637    ENDIF
    … …  
    26432643
    26442644    ! flag_aerosol=7 => MACv2SP climatology
    2645     IF (flag_aerosol.EQ.7.AND. iflag_rrtm.NE.1) THEN
     2645    IF (flag_aerosol==7.AND. iflag_rrtm/=1) THEN
    26462646       CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with RRTM',1)
    26472647    ENDIF
    2648     IF (flag_aerosol.EQ.7.AND. NSW.NE.6) THEN
     2648    IF (flag_aerosol==7.AND. NSW/=6) THEN
    26492649       CALL abort_physic('conf_phys', 'flag_aerosol=7 (MACv2SP) can only be activated with NSW=6',1)
    26502650    ENDIF
    26512651
    26522652    ! 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) THEN
     2653    IF (flag_bc_internal_mixture .AND. NSW/=6) THEN
    26542654       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with NSW=6',1)
    26552655    ENDIF
    2656     IF (flag_bc_internal_mixture .AND. iflag_rrtm.NE.1) THEN
     2656    IF (flag_bc_internal_mixture .AND. iflag_rrtm/=1) THEN
    26572657       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with RRTM',1)
    26582658    ENDIF
    2659     IF (flag_bc_internal_mixture .AND. flag_aerosol.NE.6) THEN
     2659    IF (flag_bc_internal_mixture .AND. flag_aerosol/=6) THEN
    26602660       CALL abort_physic('conf_phys', 'flag_bc_internal_mixture can only be activated with flag_aerosol=6',1)
    26612661    ENDIF
    26622662
    26632663    ! test sur flag_volc_surfstrat
    2664     IF (flag_volc_surfstrat.LT.0.OR.flag_volc_surfstrat.GT.2) THEN
     2664    IF (flag_volc_surfstrat<0.OR.flag_volc_surfstrat>2) THEN
    26652665       CALL abort_physic('conf_phys', 'flag_volc_surfstrat can only be 0 1 or 2',1)
    26662666    ENDIF
    2667     IF ((.NOT.ok_volcan.OR..NOT.ok_ade.OR..NOT.ok_aie).AND.flag_volc_surfstrat.GT.0) THEN
     2667    IF ((.NOT.ok_volcan.OR..NOT.ok_ade.OR..NOT.ok_aie).AND.flag_volc_surfstrat>0) THEN
    26682668       CALL abort_physic('conf_phys', 'ok_ade, ok_aie, ok_volcan need to be activated if flag_volc_surfstrat is 1 or 2',1)
    26692669    ENDIF
    … …  
    26792679
    26802680    ! Test on chemistry cycle
    2681     IF ((type_trac .ne. "inca" .AND. type_trac .ne. "inco") .AND. ( dms_cycle_cpl .OR. n2o_cycle_cpl)  ) THEN
     2681    IF ((type_trac /= "inca" .AND. type_trac /= "inco") .AND. ( dms_cycle_cpl .OR. n2o_cycle_cpl)  ) THEN
    26822682       CALL abort_physic('conf_phys', 'dms_cycle_cpl or n2o_cycle_cpl has to be TRUE only with INCA coupling model',1)
    26832683    ENDIF

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/m_mrgrnk.F90

    r3241 r5081  
    3333         IRNGT (1) = 1
    3434         Return
    35       Case Default
    36          Continue
    3735      End Select
    3836!
    … …  
    233231         IRNGT (1) = 1
    234232         Return
    235       Case Default
    236          Continue
    237233      End Select
    238234!

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp/optics_lib.F90

    r2428 r5081  
    3838 
    3939! ----- INPUTS -----
    40   real*8, intent(in) :: freq,tk
     40  real(kind=8), intent(in) :: freq,tk
    4141 
    4242! ----- OUTPUTS -----
    43   real*8, intent(out) :: n_r, n_i
     43  real(kind=8), intent(out) :: n_r, n_i
    4444
    4545! ----- INTERNAL -----   
    46   real*8 ld,es,ei,a,ls,sg,tm1,cos1,sin1
    47   real*8 e_r,e_i
    48   real*8 pi
    49   real*8 tc
    50   complex*16 e_comp, sq
     46  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
    5151
    5252  tc = tk - 273.15
    … …  
    102102
    103103! ----- INPUTS -----
    104   real*8, intent(in) :: freq, t
     104  real(kind=8), intent(in) :: freq, t
    105105 
    106106! ----- OUTPUTS ----- 
    107   real*8, intent(out) :: n_r,n_i
     107  real(kind=8), intent(out) :: n_r,n_i
    108108
    109109! Parameters:
    110   integer*2 :: i,lt1,lt2,nwl,nwlt
     110  integer(kind=2) :: i,lt1,lt2,nwl,nwlt
    111111  parameter(nwl=468,nwlt=62)
    112112
    113   real*8 :: alam,cutice,pi,t1,t2,wlmax,wlmin, &
     113  real(kind=8) :: alam,cutice,pi,t1,t2,wlmax,wlmin, &
    114114            x,x1,x2,y,y1,y2,ylo,yhi,tk
    115115
    116   real*8 :: &
     116  real(kind=8) :: &
    117117       tabim(nwl),tabimt(nwlt,4),tabre(nwl),tabret(nwlt,4),temref(4), &
    118118       wl(nwl),wlt(nwlt)
    … …  
    540540    if(tk < temref(4)) tk=temref(4)
    541541    do 11 i=2,4
    542       if(tk.ge.temref(i)) go to 12
     542      if(tk>=temref(i)) go to 12
    543543    11 continue
    544544    12 lt1=i
    545545    lt2=i-1
    546546    do 13 i=2,nwlt
    547       if(alam.le.wlt(i)) go to 14
     547      if(alam<=wlt(i)) go to 14
    548548    13 continue
    549549    14 x1=log(wlt(i-1))
    … …  
    586586      Subroutine MieInt(Dx, SCm, Inp, Dqv, Dqxt, Dqsc, Dbsc, Dg, Xs1, Xs2, DPh, Error)
    587587
    588       Integer * 2  Imaxx
     588      Integer (kind=2)  Imaxx
    589589      Parameter (Imaxx = 12000)
    590       Real * 4     RIMax          ! largest real part of refractive index
     590      Real (kind=4)     RIMax          ! largest real part of refractive index
    591591      Parameter (RIMax = 2.5)
    592       Real * 4     IRIMax         ! largest imaginary part of refractive index
     592      Real (kind=4)     IRIMax         ! largest imaginary part of refractive index
    593593      Parameter (IRIMax = -2)
    594       Integer * 2  Itermax
     594      Integer (kind=2)  Itermax
    595595      Parameter (Itermax = 12000 * 2.5)
    596596                                ! must be large enough to cope with the
    597597                                ! largest possible nmx = x * abs(scm) + 15
    598598                                ! or nmx =  Dx + 4.05*Dx**(1./3.) + 2.0
    599       Integer * 2  Imaxnp
     599      Integer (kind=2)  Imaxnp
    600600      Parameter (Imaxnp = 10000)  ! Change this as required
    601601!     INPUT
    602       Real * 8     Dx
    603       Complex * 16  SCm
    604       Integer * 4  Inp
    605       Real * 8     Dqv(Inp)
     602      Real (kind=8)     Dx
     603      Complex (kind=8)  SCm
     604      Integer (kind=4)  Inp
     605      Real (kind=8)     Dqv(Inp)
    606606!     OUTPUT
    607       Complex * 16  Xs1(InP)
    608       Complex * 16  Xs2(InP)
    609       Real * 8     Dqxt
    610       Real * 8     Dqsc
    611       Real * 8     Dg
    612       Real * 8     Dbsc
    613       Real * 8     DPh(InP)
    614       Integer * 4  Error
     607      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
    615615!     LOCAL
    616       Integer * 2  I
    617       Integer * 2  NStop
    618       Integer * 2  NmX
    619       Integer * 4  N    ! N*N > 32767 ie N > 181
    620       Integer * 4  Inp2
    621       Real * 8     Chi,Chi0,Chi1
    622       Real * 8     APsi,APsi0,APsi1
    623       Real * 8     Pi0(Imaxnp)
    624       Real * 8     Pi1(Imaxnp)
    625       Real * 8     Taun(Imaxnp)
    626       Real * 8     Psi,Psi0,Psi1
    627       Complex * 8  Ir
    628       Complex * 16 Cm
    629       Complex * 16 A,ANM1,APB
    630       Complex * 16 B,BNM1,AMB
    631       Complex * 16 D(Itermax)
    632       Complex * 16 Sp(Imaxnp)
    633       Complex * 16 Sm(Imaxnp)
    634       Complex * 16 Xi,Xi0,Xi1
    635       Complex * 16 Y
     616      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
    636636!     ACCELERATOR VARIABLES
    637       Integer * 2  Tnp1
    638       Integer * 2  Tnm1
    639       Real * 8     Dn
    640       Real * 8     Rnx
    641       Real * 8     S(Imaxnp)
    642       Real * 8     T(Imaxnp)
    643       Real * 8     Turbo
    644       Real * 8     A2
    645       Complex * 16 A1
     637      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
    646646     
    647       If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
     647      If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then
    648648        Error = 1
    649649        Return
    … …  
    652652      Ir = 1 / Cm
    653653      Y =  Dx * Cm
    654       If (Dx.Lt.0.02) Then
     654      If (Dx<0.02) Then
    655655         NStop = 2
    656656      Else
    657          If (Dx.Le.8.0) Then
     657         If (Dx<=8.0) Then
    658658            NStop = Dx + 4.00*Dx**(1./3.) + 2.0
    659659         Else
    660             If (Dx.Lt. 4200.0) Then
     660            If (Dx< 4200.0) Then
    661661               NStop = Dx + 4.05*Dx**(1./3.) + 2.0
    662662            Else
    … …  
    666666      End If
    667667      NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
    668       If (Nmx .gt. Itermax) then
     668      If (Nmx > Itermax) then
    669669          Error = 1
    670670          Return
    … …  
    709709         Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
    710710         Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
    711          If (N.Gt.1) then
     711         If (N>1) then
    712712         Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    713713         End If
    … …  
    717717         AMB = A2 * (A - B)
    718718         Do I = 1,Inp2
    719             If (I.GT.Inp) Then
     719            If (I>Inp) Then
    720720               S(I) = -Pi1(I)
    721721            Else
    … …  
    736736         Xi1 = Dcmplx(APsi1,Chi1)
    737737      End Do
    738       If (Dg .GT.0) Dg = 2 * Dg / Dqsc
     738      If (Dg >0) Dg = 2 * Dg / Dqsc
    739739      Dqsc =  2 * Dqsc / Dx**2
    740740      Dqxt =  2 * Dqxt / Dx**2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cosp2/mrgrnk.F90

    r3358 r5081  
    6868       IRNGT (1) = 1
    6969       Return
    70     Case Default
    71        Continue
    7270    End Select
    7371    !
    … …  
    268266       IRNGT (1) = 1
    269267       Return
    270     Case Default
    271        Continue
    272268    End Select
    273269    !
    … …  
    467463       IRNGT (1) = 1
    468464       Return
    469     Case Default
    470        Continue
    471465    End Select
    472466    !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/cosp_optics.F90

    r3491 r5081  
    7272    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    7373    do j=1,dim2
    74        where(flag(:,j,:) .eq. 1)
     74       where(flag(:,j,:) == 1)
    7575          varOUT(:,j,:) = varIN2
    7676       endwhere
    77        where(flag(:,j,:) .eq. 2)
     77       where(flag(:,j,:) == 2)
    7878          varOUT(:,j,:) = varIN1
    7979       endwhere
    … …  
    9696   
    9797    varOUT(1:dim1,1:dim2,1:dim3) = 0._wp
    98    where(flag(:,:,:) .eq. 1)
     98   where(flag(:,:,:) == 1)
    9999       varOUT(:,:,:) = varIN2
    100100    endwhere
    101     where(flag(:,:,:) .eq. 2)
     101    where(flag(:,:,:) == 2)
    102102       varOUT(:,:,:) = varIN1
    103103    endwhere
    … …  
    295295
    296296    ! Which LIDAR frequency are we using?
    297     if (lidar_freq .eq. 355) then
     297    if (lidar_freq == 355) then
    298298       Cmol   = Cmol_355nm
    299299       rdiffm = rdiffm_355nm
    300300    endif
    301     if (lidar_freq .eq. 532) then
     301    if (lidar_freq == 532) then
    302302       Cmol   = Cmol_532nm
    303303       rdiffm = rdiffm_532nm
    … …  
    336336   
    337337    ! LS and CONV Ice water coefficients
    338     if (ice_type .eq. 0) then
     338    if (ice_type == 0) then
    339339       polpart(INDX_LSICE,1:5) = polpartLSICE0
    340340       polpart(INDX_CVICE,1:5) = polpartCVICE0
    341341    endif
    342     if (ice_type .eq. 1) then
     342    if (ice_type == 1) then
    343343       polpart(INDX_LSICE,1:5) = polpartLSICE1
    344344       polpart(INDX_CVICE,1:5) = polpartCVICE1
    … …  
    393393    ! Polynomials kp_lidar derived from Mie theory
    394394    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)
    396396          kp_part(1:npoints,1:nlev,i) = &
    397397               polpart(i,1)*(rad_part(1:npoints,1:nlev,i)*1e6)**4 &
    … …  
    426426       ! Alpha of particles in each subcolumn:
    427427       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)
    429429             alpha_part(1:npoints,1:nlev,i) = 3._wp/4._wp * Qscat &
    430430                  * rhoair(1:npoints,1:nlev) * qpart(1:npoints,1:nlev,i) &

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/mrgrnk.F90

    r3491 r5081  
    6868       IRNGT (1) = 1
    6969       Return
    70     Case Default
    71        Continue
    7270    End Select
    7371    !
    … …  
    268266       IRNGT (1) = 1
    269267       Return
    270     Case Default
    271        Continue
    272268    End Select
    273269    !
    … …  
    467463       IRNGT (1) = 1
    468464       Return
    469     Case Default
    470        Continue
    471465    End Select
    472466    !

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/optics_lib.F90

    r3491 r5081  
    558558       if(tk < temref(4)) tk=temref(4)
    559559       do i=2,4
    560           if(tk.ge.temref(i)) go to 12
     560          if(tk>=temref(i)) go to 12
    561561       enddo
    56256212     lt1 = i
    563563       lt2 = i-1
    564564       do i=2,nwlt
    565           if(alam.le.wlt(i)) go to 14
     565          if(alam<=wlt(i)) go to 14
    566566       enddo
    56756714     x1  = log(wlt(i-1))
    … …  
    652652    Complex(wp) :: A1
    653653   
    654     If ((Dx.Gt.Imaxx) .Or. (InP.Gt.ImaxNP)) Then
     654    If ((Dx>Imaxx) .Or. (InP>ImaxNP)) Then
    655655       Error = 1
    656656       Return
    … …  
    659659    Ir = 1 / Cm
    660660    Y =  Dx * Cm
    661     If (Dx.Lt.0.02) Then
     661    If (Dx<0.02) Then
    662662       NStop = 2
    663663    Else
    664        If (Dx.Le.8.0) Then
     664       If (Dx<=8.0) Then
    665665          NStop = Dx + 4.00*Dx**(1./3.) + 2.0
    666666       Else
    667           If (Dx.Lt. 4200.0) Then
     667          If (Dx< 4200.0) Then
    668668             NStop = Dx + 4.05*Dx**(1./3.) + 2.0
    669669          Else
    … …  
    673673    End If
    674674    NmX = Max(Real(NStop),Real(Abs(Y))) + 15.
    675     If (Nmx .gt. Itermax) then
     675    If (Nmx > Itermax) then
    676676       Error = 1
    677677       Return
    … …  
    726726!ds       Dqxt = Tnp1 *      Dble(A + B)          + Dqxt
    727727       Dqsc = Tnp1 * (A*Conjg(A) + B*Conjg(B)) + Dqsc
    728        If (N.Gt.1) then
     728       If (N>1) then
    729729          Dg = Dg + (dN*dN - 1) * (ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 *(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    730730!ds          Dg = Dg + (dN*dN - 1) * Dble(ANM1*Conjg(A) + BNM1 * Conjg(B)) / dN + TNM1 * Dble(ANM1*Conjg(BNM1)) / (dN*dN - dN)
    … …  
    735735       AMB = A2 * (A - B)
    736736       Do I = 1,Inp2
    737           If (I.GT.Inp) Then
     737          If (I>Inp) Then
    738738             S(I) = -Pi1(I)
    739739          Else
    … …  
    756756    End Do
    757757
    758     If (Dg .GT.0) Dg = 2 * Dg / Dqsc
     758    If (Dg >0) Dg = 2 * Dg / Dqsc
    759759    Dqsc =  2 * Dqsc / Dx**2
    760760    Dqxt =  2 * Dqxt / Dx**2

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam.F90

    r3491 r5081  
    179179         
    180180          ! 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)) then
     181          if ((rcfg%use_gas_abs == 1) .or. (rcfg%use_gas_abs == 2 .and. pr == 1)) then
    182182             if (d_gate==1) then
    183183                if (k>1) then
    … …  
    272272
    273273    ! Which platforms to create diagnostics for?
    274     if (platform .eq. 'cloudsat') lcloudsat=.true.
     274    if (platform == 'cloudsat') lcloudsat=.true.
    275275
    276276    ! Create Cloudsat diagnostics.
    … …  
    289289             enddo
    290290          enddo
    291           where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     291          where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    292292
    293293          ! Compute cloudsat near-surface precipitation diagnostics
    … …  
    306306             enddo
    307307          enddo
    308           where(cfad_ze .ne. R_UNDEF) cfad_ze = cfad_ze/Ncolumns
     308          where(cfad_ze /= R_UNDEF) cfad_ze = cfad_ze/Ncolumns
    309309       endif
    310310    endif
    … …  
    402402       do pr=1,Ncolumns
    403403          ! 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) ) then
    405              if ( (Ze_non_out(i,pr,cloudsat_preclvl).lt.100) .and. (Ze_out(i,pr,cloudsat_preclvl).lt.100) ) then
     404          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
    406406                cloudsat_precip_pia(i,pr) = Ze_non_out(i,pr,cloudsat_preclvl) - Ze_out(i,pr,cloudsat_preclvl)
    407407             endif
    … …  
    412412          ! 2a) Oceanic points.
    413413          ! ################################################################################
    414           if (land(i) .eq. 0) then
     414          if (land(i) == 0) then
    415415!             print*, 'aaa i, pr, fracPrecipIce(i,pr) : ', i, pr, fracPrecipIce(i,pr) !Artem
    416416             ! Snow
    417              if(fracPrecipIce(i,pr).gt.0.9) then
    418                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(2)) then
     417             if(fracPrecipIce(i,pr)>0.9) then
     418                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(2)) then
    419419                   cloudsat_pflag(i,pr) = pClass_Snow2                   ! TSL: Snow certain
    420420                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)) then
     421                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
     422                     Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then
    423423                   cloudsat_pflag(i,pr) = pClass_Snow1                   ! TSL: Snow possible
    424424                endif
    … …  
    426426             
    427427             ! Mixed
    428              if(fracPrecipIce(i,pr).gt.0.1.and.fracPrecipIce(i,pr).le.0.9) then
    429                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(2)) then
     428             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
    430430                   cloudsat_pflag(i,pr) = pClass_Mixed2                  ! TSL: Mixed certain
    431431                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)) then
     432                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
     433                     Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(2)) then
    434434                   cloudsat_pflag(i,pr) = pClass_Mixed1                  ! TSL: Mixed possible
    435435                endif
    … …  
    437437             
    438438             ! Rain
    439              if(fracPrecipIce(i,pr).le.0.1) then
    440                 if(Ze_non_out(i,pr,cloudsat_preclvl).gt.Zenonbinval(1)) then
     439             if(fracPrecipIce(i,pr)<=0.1) then
     440                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(1)) then
    441441                   cloudsat_pflag(i,pr) = pClass_Rain3                   ! TSL: Rain certain
    442442                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)) then
     443                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(3).and. &
     444                     Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(1)) then
    445445                   cloudsat_pflag(i,pr) = pClass_Rain2                   ! TSL: Rain probable
    446446                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)) then
     447                if(Ze_non_out(i,pr,cloudsat_preclvl)>Zenonbinval(4).and. &
     448                     Ze_non_out(i,pr,cloudsat_preclvl)<=Zenonbinval(3)) then
    449449                   cloudsat_pflag(i,pr) = pClass_Rain1                   ! TSL: Rain possible
    450450                endif
    451                 if(cloudsat_precip_pia(i,pr).gt.40) then
     451                if(cloudsat_precip_pia(i,pr)>40) then
    452452                   cloudsat_pflag(i,pr) = pClass_Rain4                   ! TSL: Heavy Rain
    453453                endif
    … …  
    455455             
    456456             ! No precipitation
    457              if(Ze_non_out(i,pr,cloudsat_preclvl).le.-15) then
     457             if(Ze_non_out(i,pr,cloudsat_preclvl)<=-15) then
    458458                cloudsat_pflag(i,pr) = pClass_noPrecip                   ! TSL: Not Raining
    459459             endif
    … …  
    463463          ! 2b) Land points.
    464464          ! ################################################################################
    465           if (land(i) .eq. 1) then
     465          if (land(i) == 1) then
    466466             ! Find Zmax, the maximum reflectivity value in the attenuated profile (Ze_out);
    467467             Zmax=maxval(Ze_out(i,pr,:))
    468468
    469469             ! Snow (T<273)
    470              if(t2m(i) .lt. 273._wp) then
    471                 if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(5)) then
     470             if(t2m(i) < 273._wp) then
     471                if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(5)) then
    472472                   cloudsat_pflag(i,pr) = pClass_Snow2                      ! JEK: Snow certain
    473473                endif
    474                 if(Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6) .and. &
    475                      Ze_out(i,pr,cloudsat_preclvl).le.Zbinvallnd(5)) then
     474                if(Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6) .and. &
     475                     Ze_out(i,pr,cloudsat_preclvl)<=Zbinvallnd(5)) then
    476476                   cloudsat_pflag(i,pr) = pClass_Snow1                      ! JEK: Snow possible
    477477                endif
    … …  
    479479             
    480480             ! Mized phase (273<T<275)
    481              if(t2m(i) .ge. 273._wp .and. t2m(i) .le. 275._wp) then
    482                 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
    483                      (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(4))) then
     481             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
    484484                   cloudsat_pflag(i,pr) = pClass_Mixed2                     ! JEK: Mixed certain
    485485                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)) ) then
     486                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
    489489                   cloudsat_pflag(i,pr) = pClass_Mixed1                     ! JEK: Mixed possible
    490490                endif
    … …  
    492492
    493493             ! Rain (T>275)
    494              if(t2m(i) .gt. 275) then
    495                 if ((Zmax .gt. Zbinvallnd(1) .and. cloudsat_precip_pia(i,pr).gt.30) .or. &
    496                      (Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(2))) then
     494             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
    497497                   cloudsat_pflag(i,pr) = pClass_Rain3                      ! JEK: Rain certain
    498498                endif
    499                 if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
    500                      (Zmax .gt. Zbinvallnd(3))) then
     499                if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. &
     500                     (Zmax > Zbinvallnd(3))) then
    501501                   cloudsat_pflag(i,pr) = pClass_Rain2                      ! JEK: Rain probable
    502502                endif
    503                 if((Ze_out(i,pr,cloudsat_preclvl) .gt. Zbinvallnd(6)) .and. &
    504                      (Zmax.lt.Zbinvallnd(3))) then
     503                if((Ze_out(i,pr,cloudsat_preclvl) > Zbinvallnd(6)) .and. &
     504                     (Zmax<Zbinvallnd(3))) then
    505505                   cloudsat_pflag(i,pr) = pClass_Rain1                      ! JEK: Rain possible
    506506                endif
    507                 if(cloudsat_precip_pia(i,pr).gt.40) then
     507                if(cloudsat_precip_pia(i,pr)>40) then
    508508                   cloudsat_pflag(i,pr) = pClass_Rain4                      ! JEK: Heavy Rain
    509509                endif
    … …  
    511511             
    512512             ! No precipitation
    513              if(Ze_out(i,pr,cloudsat_preclvl).le.-15) then
     513             if(Ze_out(i,pr,cloudsat_preclvl)<=-15) then
    514514                cloudsat_pflag(i,pr) =  pClass_noPrecip                     ! JEK: Not Precipitating
    515515             endif         
    … …  
    526526       ! Gridmean precipitation fraction for each precipitation type
    527527       do k=1,nCloudsatPrecipClass
    528           if (any(cloudsat_pflag(i,:) .eq. k-1)) then
    529              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)
    530530          endif
    531531       enddo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/quickbeam_optics.F90

    r3491 r5081  
    172172               
    173173                ! Compute effective radius from number concentration and distribution parameters
    174                 if (Re_internal .eq. 0) then
     174                if (Re_internal == 0) then
    175175                   call calc_Re(hm_matrix(pr,k,tp),Np_matrix(pr,k,tp),rho_a, &
    176176                        sd%dtype(tp),sd%apm(tp),sd%bpm(tp),sd%rho(tp),sd%p1(tp),sd%p2(tp),sd%p3(tp),Re)
    … …  
    187187                ! Index into particle size dimension of scaling tables
    188188                iRe_type=1
    189                 if(Re.gt.0) then
     189                if(Re>0) then
    190190                   ! Determine index in to scale LUT
    191191                   ! Distance between Re points (defined by "base" and "step") for
    … …  
    197197                   base = rcfg%base_list(n+1)
    198198                   iRe_type=Re/step
    199                    if (iRe_type.lt.1) iRe_type=1
     199                   if (iRe_type<1) iRe_type=1
    200200                   Re=step*(iRe_type+0.5_wp)    ! set value of Re to closest value allowed in LUT.
    201201                   iRe_type=iRe_type+base-int(n*Re_BIN_LENGTH/step)
    202202                   
    203203                   ! Make sure iRe_type is within bounds
    204                    if (iRe_type.ge.nRe_types) then
     204                   if (iRe_type>=nRe_types) then
    205205                      !write(*,*) 'Warning: size of Re exceed value permitted ', &
    206206                      !            'in Look-Up Table (LUT).  Will calculate. '
    … …  
    405405    ! Exponential is same as modified gamma with vu =1
    406406    ! if Np is specified then we will just treat as modified gamma
    407     if(dtype .eq. 2 .and. Np .gt. 0) then
     407    if(dtype == 2 .and. Np > 0) then
    408408       local_dtype = 1
    409409       local_p3    = 1
    … …  
    441441       endif
    442442       
    443        if( Np.eq.0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default 
     443       if( Np==0 .and. p2+1 > 1E-8) then     ! use default value for MEAN diameter as first default
    444444          dm = p2             ! by definition, should have units of microns
    445445          D0 = gamma(vu)/gamma(vu+1)*dm
    446446       else   ! use value of Np
    447           if(Np.eq.0) then
     447          if(Np==0) then
    448448             if( abs(p1+1) > 1E-8 ) then  !   use default number concentration   
    449449                local_Np = p1 ! total number concentration / pa --- units kg^-1
    … …  
    525525       
    526526       ! get rg ...
    527        if( Np.eq.0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
     527       if( Np==0 .and. (abs(p2+1) > 1E-8) ) then ! use default value of rg
    528528          rg = p2     
    529529       else
    … …  
    826826          log_sigma_g = p3
    827827          tmp2 = (bpm*log_sigma_g)*(bpm*log_sigma_g)
    828           if(Re.le.0) then
     828          if(Re<=0) then
    829829             rg = p2
    830830          else

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cospv2/scops.F90

    r3491 r5081  
    7575
    7676    ! Test for valid input overlap assumption
    77     if (overlap .ne. 1 .and. overlap .ne. 2 .and. overlap .ne. 3) then
     77    if (overlap /= 1 .and. overlap /= 2 .and. overlap /= 3) then
    7878       overlap=default_overlap
    7979       call errorMessage('ERROR(scops): Invalid overlap assumption provided. Using default overlap assumption (max/ran)')
    … …  
    9292    tca(1:npoints,1:nlev) = cc(1:npoints,1:nlev)
    9393   
    94     if (ncolprint.ne.0) then
     94    if (ncolprint/=0) then
    9595       write (6,'(a)') 'frac_out_pp_rev:'
    9696       do j=1,npoints,1000
    … …  
    102102       write (6,'(I3)') ncol
    103103    endif
    104     if (ncolprint.ne.0) then
     104    if (ncolprint/=0) then
    105105       write (6,'(a)') 'last_frac_pp:'
    106106       do j=1,npoints,1000
    … …  
    122122       
    123123       ! Initialise threshold
    124        IF (ilev.eq.1) then
     124       IF (ilev==1) then
    125125          ! If max overlap
    126           IF (overlap.eq.1) then
     126          IF (overlap==1) then
    127127             ! Select pixels spread evenly across the gridbox
    128128             threshold(1:npoints,1:ncol)=boxpos(1:npoints,1:ncol)
    … …  
    137137             enddo
    138138          ENDIF
    139           IF (ncolprint.ne.0) then
     139          IF (ncolprint/=0) then
    140140             write (6,'(a)') 'threshold_nsf2:'
    141141             do j=1,npoints,1000
    … …  
    147147       ENDIF
    148148       
    149        IF (ncolprint.ne.0) then
     149       IF (ncolprint/=0) then
    150150          write (6,'(a)') 'ilev:'
    151151          write (6,'(I2)') ilev
    … …  
    157157          !maxocc(1:npoints,ibox) = merge(1,0, conv(1:npoints,ilev) .gt. boxpos(1:npoints,ibox))
    158158          do j=1,npoints
    159              if (boxpos(j,ibox).le.conv(j,ilev)) then
     159             if (boxpos(j,ibox)<=conv(j,ilev)) then
    160160                maxocc(j,ibox) = 1
    161161             else
    … …  
    165165         
    166166          ! Max overlap
    167           if (overlap.eq.1) then
     167          if (overlap==1) then
    168168             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    169169             maxosc(1:npoints,ibox)        = 1               
    … …  
    171171         
    172172          ! Random overlap
    173           if (overlap.eq.2) then
     173          if (overlap==2) then
    174174             threshold_min(1:npoints,ibox) = conv(1:npoints,ilev)
    175175             maxosc(1:npoints,ibox)        = 0
    176176          endif
    177177          ! Max/Random overlap
    178           if (overlap.eq.3) then
     178          if (overlap==3) then
    179179             ! DS2014 START: The bounds on tca are not valid when ilev=1.
    180180             !threshold_min(1:npoints,ibox) = max(conv(1:npoints,ilev),min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)))
    … …  
    182182             !     min(tca(1:npoints,ilev-1),tca(1:npoints,ilev)) .and. &
    183183             !     (threshold(1:npoints,ibox).gt.conv(1:npoints,ilev)))
    184              if (ilev .ne. 1) then
     184             if (ilev /= 1) then
    185185                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) < &
    187187                     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)))
    189189             else
    190190                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) < &
    192192                     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)))
    194194             endif
    195195          endif
    … …  
    205205         
    206206          ! 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))
    208208         
    209209          ! 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)=2
     210          where(threshold(1:npoints,ibox)<=conv(1:npoints,ilev) .and. conv(1:npoints,ilev)>0.) frac_out(1:npoints,ibox,ilev)=2
    211211       ENDDO ! ibox
    212212       
    213213       
    214214       ! Set last_frac to tca at this level, so as to be tca from last level next time round
    215        if (ncolprint.ne.0) then
     215       if (ncolprint/=0) then
    216216          do j=1,npoints ,1000
    217217             write(6,'(a10)') 'j='

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cv30param.h

    r1992 r5081  
    2020      real betad
    2121
    22       COMMON /cv30param/  noff, minorig, nl, nlp, nlm &
    23                       ,  sigd, spfac &
     22      COMMON /cv30param/  sigd, spfac &
    2423!IM cf. FH : pour compatibilite avec conema3 TEMPORAIRE  :                ,pbcrit, ptcrit, epmax
    2524                      ,pbcrit, ptcrit &
    2625                      ,omtrain &
    2726                      ,dtovsh, dpbase, dttrig &
    28                       ,dtcrit, tau, beta, alpha, delta, betad
     27                      ,dtcrit, tau, beta, alpha, delta, betad &
     28                      ,noff, minorig, nl, nlp, nlm
    2929
    3030!$OMP THREADPRIVATE(/cv30param/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cv3param.h

    r3571 r5081  
    3838                      ,delta, betad  &
    3939                      ,ejectliq, ejectice &
     40                      ,flag_wb &
    4041                      ,flag_epKEorig &
    41                       ,flag_wb, cv_flag_feed &
     42                      ,cv_flag_feed &
    4243                      ,noff, minorig, nl, nlp, nlm
    4344!$OMP THREADPRIVATE(/cv3param/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cva_driver.F90

    r4613 r5081  
    858858!   is assumed useless.
    859859!
    860   compress = ncum .lt. len*comp_threshold
     860  compress = ncum < len*comp_threshold
    861861!
    862862  IF (.not. compress) THEN
    … …  
    11001100        Print *, 'cva_driver after cv3_unsat:mp , water, ice, evap, fondue '
    11011101        DO k = 1,nd
    1102         write (6, '(i4,5(1x,e13.6))'), &
     1102        write (6, '(i4,5(1x,e13.6))') &
    11031103          k, mp(igout,k), water(igout,k), ice(igout,k), &
    11041104           evap(igout,k), fondue(igout,k)
    … …  
    11061106        Print *, 'cva_driver after cv3_unsat: wdtrainA, wdtrainS, wdtrainM '     !!jygprl
    11071107        DO k = 1,nd
    1108         write (6, '(i4,3(1x,e13.6))'), &
     1108        write (6, '(i4,3(1x,e13.6))') &
    11091109           k, wdtrainA(igout,k), wdtrainS(igout,k), wdtrainM(igout,k)            !!jygprl
    11101110        ENDDO

  • LMDZ6/branches/Amaury_dev/libf/phylmd/cvparam.h

    r1992 r5081  
    2121      real delta
    2222
    23       COMMON /cvparam/ noff, minorig, nl, nlp, nlm &
    24                       ,elcrit, tlcrit &
     23      COMMON /cvparam/ elcrit, tlcrit &
    2524                      ,entp, sigs, sigd &
    2625                      ,omtrain, omtsnow, coeffr, coeffs &
    27                       ,dtmax, cu, betad, alpha, damp, delta
     26                      ,dtmax, cu, betad, alpha, damp, delta &
     27                      ,noff, minorig, nl, nlp, nlm
    2828
    2929!$OMP THREADPRIVATE(/cvparam/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/flux_arp.h

    r3780 r5081  
    1515      real :: tg
    1616
    17       common /flux_arp/fsens,flat,ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,betaevap,ok_forc_tsurf
     17      common /flux_arp/fsens,flat,betaevap,ust,tg,ok_flux_surf,ok_prescr_ust,ok_prescr_beta,ok_forc_tsurf
    1818
    1919!$OMP THREADPRIVATE(/flux_arp/)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_ratqs_ini.F90

    r4812 r5081  
    33IMPLICIT NONE
    44
    5 save
     5INTEGER :: lunout
    66
    7 integer :: lunout
     7INTEGER, PROTECTED :: nbsrf,is_lic,is_ter
     8REAL, PROTECTED :: RG,RV,RD,RCPD,RLSTT,RLVTT,RTT
     9REAL, PROTECTED :: a_ratqs_cv
     10REAL, PROTECTED :: tau_var
     11REAL, PROTECTED :: fac_tau
     12REAL, PROTECTED :: tau_cumul
     13REAL, PROTECTED :: a_ratqs_wake
     14INTEGER, PROTECTED :: dqimpl
    815
    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(:,:)
     16REAL, ALLOCATABLE :: povariance(:,:)
    1917!$OMP THREADPRIVATE(povariance)
    20 real, allocatable, SAVE :: var_conv(:,:)
     18REAL, ALLOCATABLE :: var_conv(:,:)
    2119!$OMP THREADPRIVATE(var_conv)
    2220
    … …  
    7876!--------------------------------------------------------
    7977
    80 if (klon.eq.1) then
     78if (klon==1) then
    8179    do k=1,klev
    8280      do i=1,klon

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_ini.F90

    r4863 r5081  
    22
    33IMPLICIT NONE
    4 
    5 save
    6 
    74
    85integer, protected :: dvdq=1,dqimpl=-1,prt_level=0,lunout

  • LMDZ6/branches/Amaury_dev/libf/phylmd/rrtm/rrtm_taumol1.F90

    r2003 r5081  
    190190IF (LHOOK) CALL DR_HOOK('RRTM_TAUMOL1',0,ZHOOK_HANDLE)
    191191!--ajout OB
    192 IF (K_LAYTROP.GT.100) THEN
     192IF (K_LAYTROP>100) THEN
    193193PRINT *,'ATTENTION KLAY_TROP > 100 PROBLEME ARRAY DANS RRTM ON ARRETE'
    194194STOP

  • LMDZ6/branches/Amaury_dev/libf/phylmd/tlift.F90

    r2197 r5081  
    213213        tvp(i) = tpk(i)*(1.+qsat_new/eps-rr(nk))
    214214        ! jyg2
    215       ELSE
    216         CONTINUE
    217215      END IF
    218216

  • LMDZ6/branches/Amaury_dev/libf/phylmd/yamada_ini_mod.F90

    r4822 r5081  
    55
    66implicit none
    7 
    8 save
    97
    108  LOGICAL :: new_yamada4

  • LMDZ6/branches/Amaury_dev/libf/phylmdiso/add_phys_tend_mod.F90

    r5051 r5081  
    297297  END DO
    298298
    299   if (fl_ebil .GT. 0) then
     299  if (fl_ebil > 0) then
    300300    ! ------------------------------------------------
    301301    ! Compute vertical sum for each atmospheric column
    … …  
    408408!=====================================================================================
    409409
    410 IF (jbad .GT. 0) THEN
     410IF (jbad > 0) THEN
    411411      DO j = 1, jbad
    412412         i=jadrs(j)
    413          if(prt_level.ge.debug_level) THEN
     413         if(prt_level>=debug_level) THEN
    414414          print*,'PLANTAGE POUR LE POINT i lon lat =',&
    415415                 i,longitude_deg(i),latitude_deg(i),text
    … …  
    426426! Impression, warning et correction en cas de probleme moins important
    427427!=====================================================================================
    428 IF (jqbad .GT. 0) THEN
     428IF (jqbad > 0) THEN
    429429      done(:) = .false.                         !jyg
    430430      DO j = 1, jqbad
    431431        i=jqadrs(j)
    432           if(prt_level.ge.debug_level) THEN
     432          if(prt_level>=debug_level) THEN
    433433           print*,'WARNING  : EAU POUR LE POINT i lon lat =',&
    434434                  i,longitude_deg(i),latitude_deg(i),text
    … …  
    465465              enddo
    466466#endif
    467               if(prt_level.ge.debug_level) THEN
     467              if(prt_level>=debug_level) THEN
    468468               print*,' cas q_seri<1.e-15 i k zq_int zqp_int zq_int/zqp_int :', &
    469469                                    i, kqadrs(j), zq_int, zqp_int, zq_int/zqp_int
    … …  
    487487            DO k = 1, klev
    488488              zq=q_seri(i,k)+zdq(i,k)
    489               if (zq.lt.1.e-15) then
    490                  if (q_seri(i,k).lt.1.e-15) then
    491                   if(prt_level.ge.debug_level) THEN
     489              if (zq<1.e-15) then
     490                 if (q_seri(i,k)<1.e-15) then
     491                  if(prt_level>=debug_level) THEN
    492492                   print*,' cas q_seri<1.e-15 i k q_seri zq zdq :',i,k,q_seri(i,k),zq,zdq(i,k)
    493493                  endif
    … …  
    555555         ENDDO
    556556      ENDDO
    557 IF (jbad .GT. 0) THEN
     557IF (jbad > 0) THEN
    558558      DO j = 1, jbad
    559559         i=jadrs(j)
    560560         k=kadrs(j)
    561          if(prt_level.ge.debug_level) THEN
     561         if(prt_level>=debug_level) THEN
    562562          print*,'PLANTAGE2 POUR LE POINT i itap lon lat txt jbad zdt t',&
    563563                 i,itap,longitude_deg(i),latitude_deg(i),text,jbad, &
    … …  
    573573ENDIF
    574574!
    575 IF (jqbad .GT. 0) THEN
     575IF (jqbad > 0) THEN
    576576      DO j = 1, jqbad
    577577         i=jqadrs(j)
    578578         k=kqadrs(j)
    579          if(prt_level.ge.debug_level) THEN
     579         if(prt_level>=debug_level) THEN
    580580          print*,'WARNING  : EAU2 POUR LE POINT i itap lon lat txt jqbad zdq q zdql ql',&
    581581                 i,itap,longitude_deg(i),latitude_deg(i),text,jqbad,&
    … …  
    613613!======================================================================
    614614
    615   if (fl_ebil .GT. 0) then
     615  if (fl_ebil > 0) then
    616616 
    617617    ! ------------------------------------------------
    … …  
    764764  END DO
    765765
    766   if (fl_ebil .GT. 0) then
     766  if (fl_ebil > 0) then
    767767    ! ------------------------------------------------
    768768    ! Compute vertical sum for each atmospheric column
    … …  
    795795!======================================================================
    796796
    797   if (fl_ebil .GT. 0) then
     797  if (fl_ebil > 0) then
    798798 
    799799    ! ------------------------------------------------
    … …  
    944944
    945945!!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)) then
     946if ( (fl_ebil > 0) .and. (klon == 1)) then
    947947
    948948  bilq_bnd = 0.
    … …  
    976976  bilh_error = d_h_col(1) - bilh_bnd
    977977! are the errors too large?
    978   if ( abs(bilq_error) .gt. bilq_seuil) bilq_ok=1
    979   if ( abs(bilh_error) .gt. bilh_seuil) bilh_ok=1
     978  if ( abs(bilq_error) > bilq_seuil) bilq_ok=1
     979  if ( abs(bilh_error) > bilh_seuil) bilh_ok=1
    980980!
    981981! Print diagnostics
    982982! =================
    983   if ( (bilq_ok .eq. 0).and.(bilh_ok .eq. 0) ) then
     983  if ( (bilq_ok == 0).and.(bilh_ok == 0) ) then
    984984    status="enerbil-OK"
    985985  else
    … …  
    987987  end if
    988988
    989   if ( prt_level .GE. 3) then
     989  if ( prt_level >= 3) then
    990990    write(*,9010) text,status," itap:",itap,"enerbilERROR: Q", bilq_error,"  H", bilh_error
    9919919010  format (1x,A8,2x,A12,A6,I4,A18,E15.6,A5,E15.6)
    992992  end if
    993   if ( prt_level .GE. 3) then
     993  if ( prt_level >= 3) then
    994994    write(*,9000) text,"enerbil: Q,H,KE budget", d_qt_col(1), d_h_col(1),d_ek_col(1)
    995995  end if
    996   if ( prt_level .GE. 5) then
     996  if ( prt_level >= 5) then
    997997    write(*,9000) text,"enerbil at boundaries: Q, H",bilq_bnd, bilh_bnd
    998998    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)
    … …  
    10021002  specific_diag: SELECT CASE (text)
    10031003  CASE("vdf") specific_diag
    1004     if ( prt_level .GE. 5) then
     1004    if ( prt_level >= 5) then
    10051005      write(*,9000) text,"enerbil: d_h, bilh, sens,t_seri", d_h_col(1), bilh_bnd, sens(1), t_seri(1,1)
    10061006      write(*,9000) text,"enerbil: d_h_col_vdf, f_h, diff",d_h_col_vdf, f_h_bnd, bilh_bnd-sens(1)
    10071007    end if
    10081008  CASE("lsc") specific_diag
    1009     if ( prt_level .GE. 5) then
     1009    if ( prt_level >= 5) then
    10101010      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)
    10111011      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)
    10121012    end if
    10131013  CASE("convection") specific_diag
    1014     if ( prt_level .GE. 5) then
     1014    if ( prt_level >= 5) then
    10151015      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)
    10161016      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  
    61756175    itaprad = itaprad + 1
    61766176
    6177     IF (iflag_radia.eq.0) THEN
    6178        IF (prt_level.ge.9) THEN
     6177    IF (iflag_radia==0) THEN
     6178       IF (prt_level>=9) THEN
    61796179          PRINT *,'--------------------------------------------------'
    61806180          PRINT *,'>>>> ATTENTION rayonnement desactive pour ce cas'
    … …  
    62586258    ! a l'echelle sous-maille:
    62596259    !
    6260     IF (prt_level .GE.10) THEN
     6260    IF (prt_level >=10) THEN
    62616261       print *,' call orography ? ', ok_orodr
    62626262    ENDIF
    … …  
    62746274          ! zpmm_orodr_t and zstd_orodr_t are activation thresholds set by F. Lott to
    62756275          ! 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)) THEN
     6276          IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
    62776277             itest(i)=1
    62786278             igwd=igwd+1
    … …  
    63316331          !    such as ice sheets (work by V. Wiener)
    63326332          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)) THEN
     6333          IF (((zpic(i)-zmea(i))>zpmm_orolf_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
    63346334             itest(i)=1
    63356335             igwd=igwd+1
    … …  
    65556555       CALL getin_p('addtkeoro',addtkeoro)
    65566556     
    6557        IF (prt_level.ge.5) &
     6557       IF (prt_level>=5) &
    65586558            print*,'addtkeoro', addtkeoro
    65596559           
    … …  
    65766576!
    65776577
    6578        IF (addtkeoro .GT. 0 .AND. ok_orodr ) THEN
     6578       IF (addtkeoro > 0 .AND. ok_orodr ) THEN
    65796579!      -------------------------------------------
    65806580
    … …  
    65836583
    65846584
    6585   IF (addtkeoro .EQ. 1 ) THEN
     6585  IF (addtkeoro == 1 ) THEN
    65866586
    65876587            duadd(:,:)=alphatkeoro*d_u_oro(:,:)
    65886588            dvadd(:,:)=alphatkeoro*d_v_oro(:,:)
    65896589
    6590   ELSE IF (addtkeoro .EQ. 2) THEN
     6590  ELSE IF (addtkeoro == 2) THEN
    65916591
    65926592     IF (smallscales_tkeoro) THEN
    … …  
    65976597! car on peut s'attendre a ce que les petites echelles produisent aussi de la TKE
    65986598! 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)) THEN
     6599          IF ((zstd(i)>1.0) .AND.(zrel_oro(i)<=zrel_oro_t)) THEN
    66006600             itest(i)=1
    66016601             igwd=igwd+1
    … …  
    66096609       DO i=1,klon
    66106610          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)) THEN
     6611        IF (((zpic(i)-zmea(i))>zpmm_orodr_t).AND.(zstd(i)>zstd_orodr_t).AND.(zrel_oro(i)<=zrel_oro_t)) THEN
    66126612             itest(i)=1
    66136613             igwd=igwd+1
    … …  
    68316831  IF (ok_airs) then
    68326832
    6833   IF (itap.eq.1.or.MOD(itap,NINT(freq_airs/phys_tstep)).EQ.0) THEN
     6833  IF (itap==1.or.MOD(itap,NINT(freq_airs/phys_tstep))==0) THEN
    68346834     write(*,*) 'je vais appeler simu_airs, ok_airs, freq_airs=', ok_airs, freq_airs
    68356835     CALL simu_airs(itap,rneb, t_seri, cldemi, fiwc, ref_ice, pphi, pplay, paprs,&
    … …  
    69386938    IF (offline) THEN
    69396939
    6940        IF (prt_level.ge.9) &
     6940       IF (prt_level>=9) &
    69416941            print*,'Attention on met a 0 les thermiques pour phystoke'
    69426942       CALL phystokenc ( &
    … …  
    69596959    !
    69606960    !IM global posePB BEG
    6961     IF(1.EQ.0) THEN
     6961    IF(1==0) THEN
    69626962       !
    69636963       CALL transp_lay (paprs,zxtsol, t_seri, q_seri, u_seri, v_seri, zphi, &
    … …  
    71187118    ! Convertir les incrementations en tendances
    71197119    !
    7120     IF (prt_level .GE.10) THEN
     7120    IF (prt_level >=10) THEN
    71217121       print *,'Convertir les incrementations en tendances '
    71227122    ENDIF
    … …  
    71417141          ENDIF
    71427142          !--ice_sursat: nqo=4, on ajoute rneb
    7143           IF (nqo.ge.4 .and. ok_ice_sursat) THEN
     7143          IF (nqo>=4 .and. ok_ice_sursat) THEN
    71447144             d_qx(i,k,irneb) = ( rneb_seri(i,k) - qx(i,k,irneb) ) / phys_tstep
    71457145          ENDIF
    71467146
    7147            IF (nqo.ge.4 .and. ok_bs) THEN
     7147           IF (nqo>=4 .and. ok_bs) THEN
    71487148             d_qx(i,k,ibs) = ( qbs_seri(i,k) - qx(i,k,ibs) ) / phys_tstep
    71497149          ENDIF
    … …  
    72167216    !==========================================================================
    72177217
    7218     IF (prt_level.ge.1) THEN
     7218    IF (prt_level>=1) THEN
    72197219       write(lunout,*) 'FIN DE PHYSIQ !!!!!!!!!!!!!!!!!!!!'
    72207220       write(lunout,*) &

  • LMDZ6/branches/Amaury_dev/tools/netcdf95/nf95_abort.f90

    r5075 r5081  
    77  subroutine nf95_abort(message, ncerr, ncid, varid)
    88
    9     use, intrinsic:: iso_fortran_env
     9    use, intrinsic:: iso_fortran_env, ONLY: error_unit
    1010
    11     ! Libraries:
     11    ! Libraries:mod_phys_lmdz_mpi_transfert
    1212    use lmdz_netcdf, only: nf90_strerror
    1313
Note: See TracChangeset for help on using the changeset viewer.