Ignore:
Timestamp:
Jul 24, 2024, 4:23:34 PM (4 months ago)
Author:
abarral
Message:

rename modules properly lmdz_*
move some unused files to obsolete/
(lint) uppercase fortran keywords

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
37 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/adaptdt.f90

    r5116 r5117  
    4040    n=int(CFLmax)+1
    4141  ! pour reproduire cas VL du code qui appele x,y,z,y,x
    42      ! if (nadv.eq.30) n=n/2   ! Pour Prather
     42     ! if (nadv.EQ.30) n=n/2   ! Pour Prather
    4343    dtbon=dtvr/n
    4444

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/advn.f90

    r5116 r5117  
    148148  REAL :: dxqu(ip1jmp1),zqu(ip1jmp1)
    149149  REAL :: zqmax(ip1jmp1),zqmin(ip1jmp1)
    150   logical :: extremum(ip1jmp1)
     150  LOGICAL :: extremum(ip1jmp1)
    151151
    152152  INTEGER :: mode
    … …  
    156156  !   calcul des pentes en u:
    157157  !   -----------------------
    158   if (mode==0) THEN
     158  IF (mode==0) THEN
    159159     do l=1,llm
    160160        do ij=1,ip1jm
    … …  
    230230     enddo
    231231     do ij=iip2,ip1jm-1
    232         if (extremum(ij).and..not.extremum(ij+1)) &
     232        IF (extremum(ij).and..not.extremum(ij+1)) &
    233233              qg(ij+1,l)=q(ij,l)
    234234     enddo
    … …  
    2392398888   continue
    240240  enddo
    241   endif
     241  ENDIF
    242242  RETURN
    243243END SUBROUTINE advnqx
    … …  
    265265  REAL :: dyqv(ip1jm),zqv(ip1jm,llm)
    266266  REAL :: zqmax(ip1jm),zqmin(ip1jm)
    267   logical :: extremum(ip1jmp1)
     267  LOGICAL :: extremum(ip1jmp1)
    268268
    269269  INTEGER :: mode
    … …  
    271271  data mode/1/
    272272
    273   if (mode==0) THEN
     273  IF (mode==0) THEN
    274274     do l=1,llm
    275275        do ij=1,ip1jmp1
    … …  
    318318           qs(ij,l)=q(ij,l)
    319319           qn(ij,l)=q(ij,l)
    320            ! if (.not.extremum(ij-iip1)) qs(ij-iip1,l)=q(ij,l)
    321            ! if (.not.extremum(ij+iip1)) qn(ij+iip1,l)=q(ij,l)
     320           ! if (.NOT.extremum(ij-iip1)) qs(ij-iip1,l)=q(ij,l)
     321           ! if (.NOT.extremum(ij+iip1)) qn(ij+iip1,l)=q(ij,l)
    322322        else
    323323           qs(ij,l)=zqv(ij,l)
    … …  
    334334
    335335  enddo
    336   endif
     336  ENDIF
    337337  RETURN
    338338END SUBROUTINE advnqy
    … …  
    361361  REAL :: dzqw(ip1jmp1,llm+1),zqw(ip1jmp1,llm+1)
    362362  REAL :: zqmax(ip1jmp1,llm),zqmin(ip1jmp1,llm)
    363   logical :: extremum(ip1jmp1,llm)
     363  LOGICAL :: extremum(ip1jmp1,llm)
    364364
    365365  INTEGER :: mode
    … …  
    371371  !   -----------------------
    372372
    373   if (mode==0) THEN
     373  IF (mode==0) THEN
    374374     do l=1,llm
    375375        do ij=1,ip1jmp1
    … …  
    436436  !    do ij=1,ip1jmp1
    437437  !       IF(extremum(ij,l)) THEN
    438   !          if (.not.extremum(ij,l-1)) qh(ij,l-1)=q(ij,l)
    439   !          if (.not.extremum(ij,l+1)) qb(ij,l+1)=q(ij,l)
     438  !          if (.NOT.extremum(ij,l-1)) qh(ij,l-1)=q(ij,l)
     439  !          if (.NOT.extremum(ij,l+1)) qb(ij,l+1)=q(ij,l)
    440440  !       endif
    441441  !    enddo
    … …  
    449449  enddo
    450450
    451   endif
     451  ENDIF
    452452
    453453  RETURN
    … …  
    491491  REAL :: zm,zq,zsigm,zsigp,zqm,zqp,zu
    492492
    493   logical :: ladvplus(ip1jmp1,llm)
     493  LOGICAL :: ladvplus(ip1jmp1,llm)
    494494
    495495  REAL :: prec
    … …  
    506506           !    qd(ij,l)=q(ij,l)
    507507           !    qg(ij,l)=q(ij,l)
    508            ! endif
     508           ! END IF
    509509           IF(abs(zdq)>prec) THEN
    510510              zsigd(ij,l)=(q(ij,l)-qg(ij,l))/zdq
    511511              zsigg(ij,l)=1.-zsigd(ij,l)
    512               ! IF(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and.
     512              ! IF(.NOT.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .AND.
    513513  !    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) THEN
    514514              !    PRINT*,'probleme au point ij=',ij,'  l=',l
    … …  
    516516              !    PRINT*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq
    517517              !    stop
    518               ! endif
     518              ! END IF
    519519           else
    520520              zsigd(ij,l)=0.5
    … …  
    530530   do l=1,llm
    531531   do ij=iip2,ip1jm-1
    532       if (u_m(ij,l)>=0.) THEN
     532      IF (u_m(ij,l)>=0.) THEN
    533533         zsigp=zsigd(ij,l)
    534534         zsigm=zsigg(ij,l)
    … …  
    549549      zsig=zu/zm
    550550      IF(zsig==0.) zsigp=0.1
    551       if (mode==1) THEN
    552          if (zsig<=zsigp) THEN
     551      IF (mode==1) THEN
     552         IF (zsig<=zsigp) THEN
    553553             u_mq(ij,l)=u_m(ij,l)*zqp
    554          else if (mode==1) THEN
     554         ELSE IF (mode==1) THEN
    555555             u_mq(ij,l)= &
    556556                   sign(zm,u_m(ij,l))*(zsigp*zqp+(zsig-zsigp)*zqm)
    557557         endif
    558558      else
    559          if (zsig<=zsigp) THEN
     559         IF (zsig<=zsigp) THEN
    560560             u_mq(ij,l)=u_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
    561561         else
    … …  
    568568      !    PRINT*,'au point ij=',ij,'  l=',l,'  sig=',zsig
    569569      !    stop
    570       ! endif
     570      ! END IF
    571571  enddo
    572572  enddo
    … …  
    605605  !   indicage des mailles concernees par le traitement special
    606606           do ij=iip2,ip1jm
    607               IF(ladvplus(ij,l).and.mod(ij,iip1)/=0) THEN
     607              IF(ladvplus(ij,l).AND.mod(ij,iip1)/=0) THEN
    608608                 iju=iju+1
    609609                 indu(iju)=ij
    … …  
    639639      ! goto 8888
    640640            zz=0.5*(zsig-zsigd(ijq,l))/zsigg(ijq,l)
    641             IF(.not.(zz>0..and.zz<=0.5)) THEN
     641            IF(.NOT.(zz>0..and.zz<=0.5)) THEN
    642642                 WRITE(lunout,*)'probleme2 au point ij=',ij, &
    643643                       '  l=',l
    … …  
    669669        ! goto 9999
    670670            zz=0.5*(zsig-zsigg(ijq,l))/zsigd(ijq,l)
    671             IF(.not.(zz>0..and.zz<=0.5)) THEN
     671            IF(.NOT.(zz>0..and.zz<=0.5)) THEN
    672672                 WRITE(lunout,*)'probleme22 au point ij=',ij &
    673673                       ,'  l=',l
    … …  
    685685        endif
    686686     enddo
    687   endif  ! n0.gt.0
     687  ENDIF  ! n0.gt.0
    688688
    689689  !   bouclage en latitude
    … …  
    763763           !    qn(ij,l)=q(ij,l)
    764764           !    qs(ij,l)=q(ij,l)
    765            ! endif
     765           ! END IF
    766766           IF(abs(zdq)>prec) THEN
    767767              zsign(ij)=(q(ij,l)-qs(ij,l))/zdq
    768768              zsigs(ij)=1.-zsign(ij)
    769               ! IF(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and.
     769              ! IF(.NOT.(zsign(ij).ge.0..and.zsign(ij).le.1. .AND.
    770770  !    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) THEN
    771771              !    PRINT*,'probleme au point ij=',ij,'  l=',l
    772772              !    PRINT*,'sigs=',zsigs(ij),'  sign=',zsign(ij)
    773773              !    stop
    774               ! endif
     774              ! END IF
    775775           else
    776776              zsign(ij)=0.5
    … …  
    782782
    783783   do ij=1,ip1jm
    784       if (v_m(ij,l)>=0.) THEN
     784      IF (v_m(ij,l)>=0.) THEN
    785785         zsigp=zsign(ij+iip1)
    786786         zsigm=zsigs(ij+iip1)
    … …  
    799799      zsig=abs(v_m(ij,l))/zm
    800800      IF(zsig==0.) zsigp=0.1
    801       if (zsig<=zsigp) THEN
     801      IF (zsig<=zsigp) THEN
    802802          v_mq(ij,l)=v_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
    803803      else
    … …  
    890890           !    qh(ij,l)=q(ij,l)
    891891           !    qb(ij,l)=q(ij,l)
    892            ! endif
     892           ! END IF
    893893
    894894           IF(abs(zdq)>prec) THEN
    … …  
    907907   do l=2,llm
    908908   do ij=1,ip1jmp1
    909       if (w_m(ij,l)>=0.) THEN
     909      IF (w_m(ij,l)>=0.) THEN
    910910         zsigp=zsigb(ij,l)
    911911         zsigm=zsigh(ij,l)
    … …  
    924924      zsig=abs(w_m(ij,l))/zm
    925925      IF(zsig==0.) zsigp=0.1
    926       if (zsig<=zsigp) THEN
     926      IF (zsig<=zsigp) THEN
    927927          w_mq(ij,l)=w_m(ij,l)*(zqp-0.5*zsig/zsigp*(zqp-zq))
    928928      else

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/comdissnew.h

    r5099 r5117  
    1717      INTEGER nitergdiv, nitergrot, niterh
    1818
    19       integer vert_prof_dissip ! vertical profile of horizontal dissipation
     19      INTEGER vert_prof_dissip ! vertical profile of horizontal dissipation
    2020!     Allowed values:
    2121!     0: rational fraction, function of pressure

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/diagedyn.f90

    r5116 r5117  
    273273  ! ===================================
    274274  !
    275   IF ( (idiag2>0) .and. (pas(idiag2) /= 0) ) THEN
     275  IF ( (idiag2>0) .AND. (pas(idiag2) /= 0) ) THEN
    276276    d_h_vcol  = (h_vcol_tot - h_vcol_pre(idiag2) )/dtime
    277277    d_h_dair = (h_dair_tot- h_dair_pre(idiag2))/dtime

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

    r5116 r5117  
    33SUBROUTINE disvert()
    44
    5   use ioipsl, ONLY: getin
    6   use new_unit_m, ONLY: new_unit
    7   use lmdz_assert, ONLY: assert
     5  USE ioipsl, ONLY: getin
     6  USE lmdz_new_unit, ONLY: new_unit
     7  USE lmdz_assert, ONLY: assert
    88  USE comvert_mod, ONLY: ap, bp, aps, bps, nivsigs, nivsig, dpres, presnivs, &
    99                         pseudoalt, pa, preff, scaleheight, presinter
    … …  
    6262  CALL getin('vert_sampling', vert_sampling)
    6363  WRITE(lunout,*) TRIM(modname)//' vert_sampling = ' // vert_sampling
    64   if (llm==39 .and. vert_sampling=="strato") THEN
     64  IF (llm==39 .AND. vert_sampling=="strato") THEN
    6565     dsigmin=0.3 ! Vieille option par défaut pour CMIP5
    6666  else
    6767     dsigmin=1.
    68   endif
     68  ENDIF
    6969  CALL getin('dsigmin', dsigmin)
    7070  WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/disvert_noterre.f90

    r5116 r5117  
    66  !    On l'utilise aussi pour Venus et Titan, legerment modifiee.
    77
    8   use IOIPSL
     8  USE IOIPSL
    99  USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt, &
    1010        nivsig,nivsigs,pa,preff,scaleheight
    … …  
    168168  !
    169169
    170   if (hybrid) then  ! use hybrid coordinates
     170  IF (hybrid) then  ! use hybrid coordinates
    171171     WRITE(lunout,*) "*********************************"
    172172     WRITE(lunout,*) "Using hybrid vertical coordinates"
    … …  
    191191     ENDDO
    192192     ap(llmp1) = 0.
    193   endif
     193  ENDIF
    194194
    195195  bp(llmp1) =   0.
    … …  
    213213  ENDDO
    214214
    215   if (hybrid) THEN
     215  IF (hybrid) THEN
    216216     aps(llm) = aps(llm-1)**2 / aps(llm-2)
    217217     bps(llm) = 0.5*(bp(llm) + bp(llm+1))
    … …  
    301301  x1=0
    302302  x2=1
    303   if (sig>=1) THEN
     303  IF (sig>=1) THEN
    304304        newsig= sig
    305   else if (sig*preff/pa>=0.25) THEN
     305  ELSE IF (sig*preff/pa>=0.25) THEN
    306306    DO J=1,9999  ! nombre d''iteration max
    307307      F=((1 -pa/preff)*exp(1-1./newsig**2)+(pa/preff)*newsig)/sig
    308308      ! WRITE(0,*) J, ' newsig =', newsig, ' F= ', F
    309       if (F>1) THEN
     309      IF (F>1) THEN
    310310          X2 = newsig
    311311          newsig=(X1+newsig)*0.5

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

    r5116 r5117  
    4545    INTEGER  ngrid
    4646    REAL p(ngrid,llmp1),pk(ngrid,llm)
    47     real, optional:: pkf(ngrid,llm)
     47    REAL, optional:: pkf(ngrid,llm)
    4848    REAL ps(ngrid),pks(ngrid), alpha(ngrid,llm),beta(ngrid,llm)
    4949
    … …  
    5757
    5858    ! Sanity check
    59     if (firstcall) THEN
     59    IF (firstcall) THEN
    6060       ! sanity checks for Shallow Water case (1 vertical layer)
    61        if (llm==1) THEN
    62           if (kappa/=1) THEN
     61       IF (llm==1) THEN
     62          IF (kappa/=1) THEN
    6363             CALL abort_gcm(modname, &
    6464                  "kappa!=1 , but running in Shallow Water mode!!",42)
    6565          endif
    66           if (cpp/=r) THEN
     66          IF (cpp/=r) THEN
    6767             CALL abort_gcm(modname, &
    6868                  "cpp!=r , but running in Shallow Water mode!!",42)
    6969          endif
    70        endif ! of if (llm.eq.1)
     70       endif ! of if (llm.EQ.1)
    7171
    7272       firstcall=.FALSE.
    … …  
    7474
    7575    ! Specific behaviour for Shallow Water (1 vertical layer) case:
    76     if (llm==1) THEN
     76    IF (llm==1) THEN
    7777       ! Compute pks(:),pk(:),pkf(:)
    7878
    … …  
    8282       ENDDO
    8383
    84        if (present(pkf)) THEN
     84       IF (present(pkf)) THEN
    8585          pkf = pk
    8686          CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
    … …  
    8989       ! our work is done, exit routine
    9090       RETURN
    91     endif ! of if (llm.eq.1)
     91    endif ! of if (llm.EQ.1)
    9292
    9393    ! General case:
    … …  
    137137    ENDDO
    138138
    139     if (present(pkf)) THEN
     139    IF (present(pkf)) THEN
    140140       !    calcul de pkf
    141141       pkf = pk

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

    r5116 r5117  
    4242    INTEGER  ngrid
    4343    REAL p(ngrid,llmp1),pk(ngrid,llm)
    44     real, optional:: pkf(ngrid,llm)
     44    REAL, optional:: pkf(ngrid,llm)
    4545    REAL ps(ngrid),pks(ngrid)
    4646
    … …  
    5454
    5555    ! Sanity check
    56     if (firstcall) THEN
     56    IF (firstcall) THEN
    5757       ! sanity checks for Shallow Water case (1 vertical layer)
    58        if (llm==1) THEN
    59           if (kappa/=1) THEN
     58       IF (llm==1) THEN
     59          IF (kappa/=1) THEN
    6060             CALL abort_gcm(modname, &
    6161                  "kappa!=1 , but running in Shallow Water mode!!",42)
    6262          endif
    63           if (cpp/=r) THEN
     63          IF (cpp/=r) THEN
    6464             CALL abort_gcm(modname, &
    6565                  "cpp!=r , but running in Shallow Water mode!!",42)
    6666          endif
    67        endif ! of if (llm.eq.1)
     67       endif ! of if (llm.EQ.1)
    6868
    6969       firstcall=.FALSE.
    … …  
    7171
    7272    ! Specific behaviour for Shallow Water (1 vertical layer) case:
    73     if (llm==1) THEN
     73    IF (llm==1) THEN
    7474       ! Compute pks(:),pk(:),pkf(:)
    7575
    … …  
    7979       ENDDO
    8080
    81        if (present(pkf)) THEN
     81       IF (present(pkf)) THEN
    8282          pkf = pk
    8383          CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
    … …  
    8686       ! our work is done, exit routine
    8787       RETURN
    88     endif ! of if (llm.eq.1)
     88    endif ! of if (llm.EQ.1)
    8989
    9090    ! General case:
    … …  
    116116    ENDDO
    117117
    118     if (present(pkf)) THEN
     118    IF (present(pkf)) THEN
    119119       !    calcul de pkf
    120120       pkf = pk

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

    r5116 r5117  
    1818    ! 1., taux=0., clon=0.) est à - 180 degrés.
    1919
    20     use lmdz_arth, ONLY: arth
    21     use invert_zoom_x_m, ONLY: invert_zoom_x, nmax
    22     use nrtype, ONLY: pi, pi_d, twopi, twopi_d, k8
    23     use principal_cshift_m, ONLY: principal_cshift
    24     use serre_mod, ONLY: clon, grossismx, dzoomx, taux
     20    USE lmdz_arth, ONLY: arth
     21    USE invert_zoom_x_m, ONLY: invert_zoom_x, nmax
     22    USE lmdz_physical_constants, ONLY: pi, pi_d, twopi, twopi_d, k8
     23    USE principal_cshift_m, ONLY: principal_cshift
     24    USE serre_mod, ONLY: clon, grossismx, dzoomx, taux
    2525
    2626    include "dimensions.h"
    2727    ! for iim
    2828
    29     REAL, intent(out):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
    30     real, intent(out):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
     29    REAL, INTENT(OUT):: xprimm025(:), rlonv(:), xprimv(:) ! (iim + 1)
     30    REAL, INTENT(OUT):: rlonu(:), xprimu(:), xprimp025(:) ! (iim + 1)
    3131
    3232    ! Local:
    33     real rlonm025(iim + 1), rlonp025(iim + 1)
     33    REAL rlonm025(iim + 1), rlonp025(iim + 1)
    3434    REAL dzoom, step
    35     real d_rlonv(iim)
     35    REAL d_rlonv(iim)
    3636    REAL(K8) xtild(0:2 * nmax)
    3737    REAL(K8) fhyp(nmax:2 * nmax), ffdx, beta, Xprimt(0:2 * nmax)
    … …  
    185185
    186186       IF (MINval(rlonm025(:iim)) < - pi - 0.1 &
    187             .or. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
     187            .OR. MAXval(rlonm025(:iim)) > pi + 0.1) THEN
    188188          IF (clon <= 0.) THEN
    189189             is2 = 1
    190190
    191              do while (rlonm025(is2) < - pi .and. is2 < iim)
     191             do while (rlonm025(is2) < - pi .AND. is2 < iim)
    192192                is2 = is2 + 1
    193193             END DO
    194194
    195              if (rlonm025(is2) < - pi) THEN
     195             IF (rlonm025(is2) < - pi) THEN
    196196                print *, 'Rlonm025 plus petit que - pi !'
    197197                STOP 1
    … …  
    200200             is2 = iim
    201201
    202              do while (rlonm025(is2) > pi .and. is2 > 1)
     202             do while (rlonm025(is2) > pi .AND. is2 > 1)
    203203                is2 = is2 - 1
    204204             END DO
    205205
    206              if (rlonm025(is2) > pi) THEN
     206             IF (rlonm025(is2) > pi) THEN
    207207                print *, 'Rlonm025 plus grand que pi !'
    208208                STOP 1

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

    r5116 r5117  
    1616    ! Il vaut mieux avoir : grossismy * dzoom < pi / 2
    1717
    18     use lmdz_coefpoly, ONLY: coefpoly
    19     use nrtype, ONLY: k8
    20     use serre_mod, ONLY: clat, grossismy, dzoomy, tauy
     18    USE lmdz_coefpoly, ONLY: coefpoly
     19    USE lmdz_physical_constants, ONLY: k8
     20    USE serre_mod, ONLY: clat, grossismy, dzoomy, tauy
    2121
    2222    include "dimensions.h"
    2323    ! for jjm
    2424
    25     REAL, intent(out):: rlatu(jjm + 1), yyprimu(jjm + 1)
    26     REAL, intent(out):: rlatv(jjm)
    27     real, intent(out):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
     25    REAL, INTENT(OUT):: rlatu(jjm + 1), yyprimu(jjm + 1)
     26    REAL, INTENT(OUT):: rlatv(jjm)
     27    REAL, INTENT(OUT):: rlatu2(jjm), yprimu2(jjm), rlatu1(jjm), yprimu1(jjm)
    2828
    2929    ! Local:
    … …  
    179179
    180180          it = nmax2
    181           DO while (it >= 1 .and. yfi < yf(it))
     181          DO while (it >= 1 .AND. yfi < yf(it))
    182182             it = it - 1
    183183          END DO
    … …  
    201201          DO
    202202             yi = yi - (yf1-yfi)/yprimin
    203              IF (abs(yi-yo1)<=epsilon .or. iter == 300) exit
     203             IF (abs(yi-yo1)<=epsilon .OR. iter == 300) exit
    204204             yo1 = yi
    205205             yi2 = yi*yi
    … …  
    207207             yprimin = a1 + 2.*a2*yi + 3.*a3*yi2
    208208          END DO
    209           if (abs(yi-yo1) > epsilon) THEN
     209          IF (abs(yi-yo1) > epsilon) THEN
    210210             print *, 'Pas de solution.', j, ylon2
    211211             STOP 1

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gr_int_dyn.f90

    r5116 r5117  
    3434  do j = 1, jp1
    3535    do i = 1, iim
    36       if (j == 1) THEN
     36      IF (j == 1) THEN
    3737        champdyn(i, j) = polenord
    38       else if (j == jp1) THEN
     38      ELSE IF (j == jp1) THEN
    3939        champdyn(i, j) = polesud
    4040      else

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/gradsdef.h

    r5105 r5117  
    22! $Header$
    33
    4 integer nfmx,imx,jmx,lmx,nvarmx
     4INTEGER nfmx,imx,jmx,lmx,nvarmx
    55parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000)
    66
    7 real xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
     7REAL xd(imx,nfmx),yd(jmx,nfmx),zd(lmx,nfmx),dtime(nfmx)
    88
    9 integer imd(imx),jmd(jmx),lmd(lmx)
    10 integer iid(imx),jid(jmx)
    11 integer ifd(imx),jfd(jmx)
    12 integer unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
     9INTEGER imd(imx),jmd(jmx),lmd(lmx)
     10INTEGER iid(imx),jid(jmx)
     11INTEGER ifd(imx),jfd(jmx)
     12INTEGER unit(nfmx),irec(nfmx),itime(nfmx),nld(nvarmx,nfmx)
    1313
    14 integer nvar(nfmx),ivar(nfmx)
    15 logical firsttime(nfmx)
     14INTEGER nvar(nfmx),ivar(nfmx)
     15LOGICAL firsttime(nfmx)
    1616
    1717character*10 var(nvarmx,nfmx),fichier(nfmx)

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

    r5103 r5117  
    33MODULE infotrac
    44
    5   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
    6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
     5  USE       lmdz_strings, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
     6  USE lmdz_readTracFiles, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
    77          delPhase, niso, getKey, isot_type, processIsotopes, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    88          addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate, iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    … …  
    176176    IF (nt > 1) THEN
    177177      IF (nt > 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    178       if (nt == 2) type_trac = types_trac(2)
     178      IF (nt == 2) type_trac = types_trac(2)
    179179    ENDIF
    180180

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

    r5116 r5117  
    55
    66  USE control_mod
    7   use IOIPSL
     7  USE IOIPSL
    88  USE comconst_mod, ONLY: im, imp1, jm, jmp1, lllm, lllmm1, lllmp1, &
    99                          unsim, pi, r, kappa, cpp, dtvr, dtphys
    … …  
    5353
    5454  ! vertical discretization: default behavior depends on planet_type flag
    55   if (planet_type=="earth") THEN
     55  IF (planet_type=="earth") THEN
    5656     disvert_type=1
    5757  else
    5858     disvert_type=2
    59   endif
     59  ENDIF
    6060  ! but user can also specify using one or the other in run.def:
    6161  CALL getin('disvert_type',disvert_type)
    … …  
    6565  CALL getin('pressure_exner', pressure_exner)
    6666
    67   if (disvert_type==1) THEN
     67  IF (disvert_type==1) THEN
    6868     ! standard case for Earth (automatic generation of levels)
    6969     CALL disvert()
    70   else if (disvert_type==2) THEN
     70  ELSE IF (disvert_type==2) THEN
    7171     ! standard case for planets (levels generated using z2sig.def file)
    7272     CALL disvert_noterre
    … …  
    7474     WRITE(abort_message,*) "Wrong value for disvert_type: ", disvert_type
    7575     CALL abort_gcm(modname,abort_message,0)
    76   endif
     76  ENDIF
    7777
    7878END SUBROUTINE iniconst

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

    r5116 r5117  
    1616  USE lmdz_filtreg, ONLY: filtreg
    1717  USE lmdz_libmath, ONLY: minmax
     18  USE lmdz_ran1, ONLY: ran1
    1819
    1920  IMPLICIT NONE
    … …  
    2324  include "iniprint.h"
    2425
    25   LOGICAL, INTENT(in) :: lstardis
    26   INTEGER, INTENT(in) :: nitergdiv, nitergrot, niterh
    27   REAL, INTENT(in) :: tetagdiv, tetagrot, tetatemp
    28 
    29   integer, INTENT(in) :: vert_prof_dissip
     26  LOGICAL, INTENT(IN) :: lstardis
     27  INTEGER, INTENT(IN) :: nitergdiv, nitergrot, niterh
     28  REAL, INTENT(IN) :: tetagdiv, tetagrot, tetatemp
     29
     30  INTEGER, INTENT(IN) :: vert_prof_dissip
    3031  ! Vertical profile of horizontal dissipation
    3132  ! Allowed values:
    … …  
    3637  REAL fact, zvert(llm), zz
    3738  REAL zh(ip1jmp1), zu(ip1jmp1), gx(ip1jmp1), divgra(ip1jmp1)
    38   real zv(ip1jm), gy(ip1jm), deltap(ip1jmp1, llm)
     39  REAL zv(ip1jm), gy(ip1jm), deltap(ip1jmp1, llm)
    3940  REAL ullm, vllm, umin, vmin, zhmin, zhmax
    4041  REAL zllm
    … …  
    4344  REAL tetamin
    4445  REAL pseudoz
    45   character (len = 80) :: abort_message
    46 
    47   REAL ran1
    48 
     46  CHARACTER (LEN = 80) :: abort_message
    4947
    5048  !-----------------------------------------------------------------------
    … …  
    174172  !   --------------------------------------------------
    175173
    176   if (vert_prof_dissip == 1) THEN
     174  IF (vert_prof_dissip == 1) THEN
    177175    do l = 1, llm
    178176      pseudoz = 8. * log(preff / presnivs(l))
    … …  
    190188      zvert(l) = fact - (fact - 1.) / (1. + zz * zz)
    191189    ENDDO
    192   endif
     190  ENDIF
    193191
    194192  WRITE(lunout, *)'inidissip: Constantes de temps de la diffusion horizontale'

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigeom.f90

    r5116 r5117  
    1616  !
    1717  !
    18   use fxhyp_m, ONLY: fxhyp
    19   use fyhyp_m, ONLY: fyhyp
     18  USE fxhyp_m, ONLY: fxhyp
     19  USE fyhyp_m, ONLY: fyhyp
    2020  USE comconst_mod, ONLY: pi, g, omeg, rad
    2121  USE logic_mod, ONLY: fxyhypb, ysinus

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/inigrads.f90

    r5116 r5117  
    1111  REAL :: xmin, xmax, ymin, ymax
    1212
    13   CHARACTER(LEN = *), intent(in) :: file
    14   CHARACTER(LEN = *), intent(in) :: titlel
     13  CHARACTER(LEN = *), INTENT(IN) :: file
     14  CHARACTER(LEN = *), INTENT(IN) :: titlel
    1515
    1616  INCLUDE "gradsdef.h"
    … …  
    3131  unit(9) = 46
    3232
    33   if (if<=nf) stop 'verifier les appels a inigrads'
     33  IF (if<=nf) stop 'verifier les appels a inigrads'
    3434
    3535  PRINT*, 'Entree dans inigrads'

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

    r5114 r5117  
    55  USE IOIPSL
    66  USE infotrac, ONLY: nqtot
    7   use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
     7  USE com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
    88       dynhistave_file,dynhistvave_file,dynhistuave_file
    99  USE comconst_mod, ONLY: pi
    … …  
    4242  !   Arguments
    4343
    44   integer day0, anne0
    45   real tstep, t_ops, t_wrt
     44  INTEGER day0, anne0
     45  REAL tstep, t_ops, t_wrt
    4646
    4747  ! This routine needs IOIPSL to work
    4848  !   Variables locales
    4949
    50   integer tau0
    51   real zjulian
    52   integer iq
    53   real rlong(iip1,jjp1), rlat(iip1,jjp1)
    54   integer uhoriid, vhoriid, thoriid, zvertiid
    55   integer ii,jj
    56   integer zan, dayref
     50  INTEGER tau0
     51  REAL zjulian
     52  INTEGER iq
     53  REAL rlong(iip1,jjp1), rlat(iip1,jjp1)
     54  INTEGER uhoriid, vhoriid, thoriid, zvertiid
     55  INTEGER ii,jj
     56  INTEGER zan, dayref
    5757
    5858  !--------------------------------------------------------------------

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/initfluxsto.f90

    r5116 r5117  
    6464  INTEGER :: ii, jj
    6565  INTEGER :: zan, idayref
    66   logical :: ok_sync
     66  LOGICAL :: ok_sync
    6767  !
    6868  !  Initialisations
    … …  
    211211  CALL histend(filevid)
    212212  CALL histend(filedid)
    213   if (ok_sync) THEN
     213  IF (ok_sync) THEN
    214214    CALL histsync(fileid)
    215215    CALL histsync(filevid)
    216216    CALL histsync(filedid)
    217   endif
     217  ENDIF
    218218
    219219  RETURN

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

    r5116 r5117  
    1414  SUBROUTINE inter_barxy(dlonid, dlatid, champ, rlonimod, rlatimod, champint)
    1515
    16     use lmdz_assert_eq, ONLY: assert_eq
    17     use lmdz_assert, ONLY: assert
     16    USE lmdz_assert_eq, ONLY: assert_eq
     17    USE lmdz_assert, ONLY: assert
    1818
    1919    include "dimensions.h"
    … …  
    2626    ! (for "aire", "apoln", "apols")
    2727
    28     REAL, intent(in) :: dlonid(:)
     28    REAL, INTENT(IN) :: dlonid(:)
    2929    ! (longitude from input file, in rad, from -pi to pi)
    3030
    31     REAL, intent(in) :: dlatid(:), champ(:, :), rlonimod(:)
    32 
    33     REAL, intent(in) :: rlatimod(:)
     31    REAL, INTENT(IN) :: dlatid(:), champ(:, :), rlonimod(:)
     32
     33    REAL, INTENT(IN) :: rlatimod(:)
    3434    ! (latitude angle, in degrees or rad, in strictly decreasing order)
    3535
    36     real, intent(out) :: champint(:, :)
     36    REAL, INTENT(OUT) :: champint(:, :)
    3737    ! Si taille de la seconde dim = jjm + 1, on veut interpoler sur les
    3838    ! jjm+1 latitudes rlatu du modele (latitudes des scalaires et de U)
    … …  
    4343
    4444    REAL champy(iim, size(champ, 2))
    45     integer j, i, jnterfd, jmods
     45    INTEGER j, i, jnterfd, jmods
    4646
    4747    REAL yjmod(size(champint, 2))
    … …  
    7878    ENDIF
    7979
    80     if (jmods == jjm + 1) yjmod(jjm + 1) = 90.
     80    IF (jmods == jjm + 1) yjmod(jjm + 1) = 90.
    8181
    8282    DO j = 1, jnterfd + 1
    … …  
    121121    IMPLICIT NONE
    122122
    123     REAL, intent(in) :: dlonid(:)
    124     real, intent(in) :: fdat(:)
    125     real, intent(in) :: rlonimod(:)
    126 
    127     real inter_barx(size(rlonimod))
     123    REAL, INTENT(IN) :: dlonid(:)
     124    REAL, INTENT(IN) :: fdat(:)
     125    REAL, INTENT(IN) :: rlonimod(:)
     126
     127    REAL inter_barx(size(rlonimod))
    128128
    129129    !    ...  Variables locales ...
    … …  
    184184
    185185    i = 2
    186     DO while (xxd(i) >= xxd(i - 1) .and. i < idatmax)
     186    DO while (xxd(i) >= xxd(i - 1) .AND. i < idatmax)
    187187      i = i + 1
    188188    ENDDO
    … …  
    299299    ! L'indice 1 correspond à l'interface maille 1 -- maille 2.
    300300
    301     use lmdz_assert, ONLY: assert
     301    USE lmdz_assert, ONLY: assert
    302302
    303303    IMPLICIT NONE
    304304
    305     REAL, intent(in) :: yjdat(:)
     305    REAL, INTENT(IN) :: yjdat(:)
    306306    ! (angles, ordonnées des interfaces des mailles des données, in
    307307    ! degrees, in increasing order)
    308308
    309     REAL, intent(in) :: fdat(:) ! champ de données
    310 
    311     REAL, intent(in) :: yjmod(:)
     309    REAL, INTENT(IN) :: fdat(:) ! champ de données
     310
     311    REAL, INTENT(IN) :: yjmod(:)
    312312    ! (ordonnées des interfaces des mailles du modèle)
    313313    ! (in degrees, in strictly increasing order)
    … …  
    319319    REAL y0, dy, dym
    320320    INTEGER jdat ! indice du champ de données
    321     integer jmod ! indice du champ du modèle
     321    INTEGER jmod ! indice du champ du modèle
    322322
    323323    !------------------------------------
    … …  
    373373    ! Finally, the procedure adds 90° as the last value of the array.
    374374
    375     use lmdz_assert_eq, ONLY: assert_eq
    376     use comconst_mod, ONLY: pi
     375    USE lmdz_assert_eq, ONLY: assert_eq
     376    USE comconst_mod, ONLY: pi
    377377
    378378    IMPLICIT NONE
    379379
    380     REAL, intent(in) :: xi(:)
     380    REAL, INTENT(IN) :: xi(:)
    381381    ! (latitude, in degrees or radians, in increasing or decreasing order)
    382382    ! ("xi" should contain latitudes from pole to pole.
    … …  
    385385    ! So the extreme values should not be 90° and -90°.)
    386386
    387     REAL, intent(out) :: xo(:) ! angles in degrees
    388     LOGICAL, intent(out) :: decrois
     387    REAL, INTENT(OUT) :: xo(:) ! angles in degrees
     388    LOGICAL, INTENT(OUT) :: decrois
    389389
    390390    ! Variables  local to the procedure:
    … …  
    410410    end IF
    411411
    412     IF (ABS(abs(xo(1)) - 90) < 0.001 .or. ABS(abs(xo(nmax)) - 90) < 0.001) THEN
     412    IF (ABS(abs(xo(1)) - 90) < 0.001 .OR. ABS(abs(xo(nmax)) - 90) < 0.001) THEN
    413413      print *, "ord_coord"
    414414      PRINT *, '"xi" should contain the latitudes of the boundaries of ' &
    … …  
    429429    ! order.
    430430
    431     use comconst_mod, ONLY: pi
     431    USE comconst_mod, ONLY: pi
    432432
    433433    IMPLICIT NONE
    434434
    435     REAL, intent(in) :: xi(:) ! angle, in rad or degrees
     435    REAL, INTENT(IN) :: xi(:) ! angle, in rad or degrees
    436436    REAL ord_coordm(size(xi)) ! angle, in degrees
    437437

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

    r5116 r5117  
    99  SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
    1010
    11     use lmdz_coefpoly, ONLY: coefpoly
    12     use nrtype, ONLY: pi, pi_d, twopi_d, k8
    13     use serre_mod, ONLY: clon
     11    USE lmdz_coefpoly, ONLY: coefpoly
     12    USE lmdz_physical_constants, ONLY: pi, pi_d, twopi_d, k8
     13    USE serre_mod, ONLY: clon
    1414
    1515    include "dimensions.h"
    1616    ! for iim
    1717
    18     REAL(K8), intent(in):: Xf(0:), xtild(0:), Xprimt(0:) ! (0:2 * nmax)
    19     real, intent(out):: xlon(:), xprimm(:) ! (iim)
     18    REAL(K8), INTENT(IN):: Xf(0:), xtild(0:), Xprimt(0:) ! (0:2 * nmax)
     19    REAL, INTENT(OUT):: xlon(:), xprimm(:) ! (iim)
    2020
    21     REAL(K8), intent(in):: xuv
     21    REAL(K8), INTENT(IN):: xuv
    2222    ! 0. si calcul aux points scalaires
    2323    ! 0.5 si calcul aux points U
    … …  
    2525    ! Local:
    2626    REAL(K8) xo1, Xfi, a0, a1, a2, a3, Xf1, Xprimin
    27     integer i, it, iter
     27    INTEGER i, it, iter
    2828    REAL(K8), parameter:: my_eps = 1e-6_k8
    2929
    … …  
    3737
    3838       it = 2 * nmax
    39        do while (xfi < xf(it) .and. it >= 1)
     39       do while (xfi < xf(it) .AND. it >= 1)
    4040          it = it - 1
    4141       END DO
    … …  
    5656       iter = 1
    5757
    58        do
     58       DO
    5959          xvrai(i) = xvrai(i) - (Xf1 - Xfi) / Xprimin
    60           IF (ABS(xvrai(i) - xo1) <= my_eps .or. iter == 300) exit
     60          IF (ABS(xvrai(i) - xo1) <= my_eps .OR. iter == 300) exit
    6161          xo1 = xvrai(i)
    6262          Xf1 = a0 + xvrai(i) * (a1 + xvrai(i) * (a2 + xvrai(i) * a3))
    … …  
    6464       end DO
    6565
    66        if (ABS(xvrai(i) - xo1) > my_eps) THEN
     66       IF (ABS(xvrai(i) - xo1) > my_eps) THEN
    6767          ! iter == 300
    6868          print *, 'Pas de solution.'

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/iso_verif_dyn.f90

    r5116 r5117  
    1313    INTEGER :: iso_verif_noNaN_nostop
    1414
    15     if ((x>-borne).and.(x<borne)) THEN
     15    IF ((x>-borne).AND.(x<borne)) THEN
    1616            iso_verif_noNAN_nostop=0
    1717    else
    … …  
    4747    iso_verif_egalite_nostop=0
    4848
    49     if (abs(a-b)>errmax) THEN
    50       if (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
     49    IF (abs(a-b)>errmax) THEN
     50      IF (abs((a-b)/max(max(abs(b),abs(a)),1e-18)) &
    5151            >errmaxrel) THEN
    5252        WRITE(*,*) 'erreur detectee par iso_verif_egalite:'
    … …  
    8484
    8585    ! verifier que HDO est raisonable
    86      if (q>qmin) THEN
     86     IF (q>qmin) THEN
    8787         IF(getKey('tnat', tnat, isoName(iso))) THEN
    8888              err_msg = 'Missing isotopic parameter "tnat"'
    … …  
    9191         END IF
    9292         deltaD=(x/q/tnat-1)*1000
    93          if ((deltaD>deltaDmax).or.(deltaD<deltaDmin)) THEN
     93         IF ((deltaD>deltaDmax).OR.(deltaD<deltaDmin)) THEN
    9494              WRITE(*,*) 'erreur detectee par iso_verif_aberrant:'
    9595              WRITE(*,*) err_msg
    … …  
    9898              WRITE(*,*) 'iso=',iso
    9999              iso_verif_aberrant_nostop=1
    100          endif !if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) THEN
     100         endif !if ((deltaD.gt.deltaDmax).OR.(deltaD.lt.deltaDmin)) THEN
    101101      endif !if (q(i,k,iq).gt.qmin) THEN
    102102    RETURN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limx.f90

    r5116 r5117  
    8585     do ij=iip2+1,ip1jm
    8686        IF(     dxqu(ij-1)*dxqu(ij)>0. &
    87               .and. dxq(ij,l)*dxqu(ij)>0.) THEN
     87              .AND. dxq(ij,l)*dxqu(ij)>0.) THEN
    8888          dxq(ij,l)= &
    8989                sign(min(abs(dxq(ij,l)),dxqmax(ij)),dxq(ij,l))

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

    r5116 r5117  
    6767     sinlon(1)=sinlon(iip1)
    6868     sinlondlon(1)=sinlondlon(iip1)
    69   endif
     69  ENDIF
    7070
    7171  !
    … …  
    158158        dyqmax(ij)=pente_max*abs(dyqv(ij))
    159159     enddo
    160   endif
     160  ENDIF
    161161
    162162  IF(dyqv(ismax(iim,dyqv(ip1jm-iip1+1),1)+ip1jm-iip1+1)* &
    … …  
    170170        dyqmax(ij)=pente_max*abs(dyqv(ij-iip1))
    171171     enddo
    172   endif
     172  ENDIF
    173173
    174174  !   calcul des pentes limitees

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/limz.f90

    r5116 r5117  
    7878     do l=2,llm-1
    7979        IF(     dzqw(l-1)*dzqw(l)>0. &
    80               .and. dzq(ij,l)*dzqw(l)>0.) THEN
     80              .AND. dzq(ij,l)*dzqw(l)>0.) THEN
    8181          dzq(ij,l)= &
    8282                sign(min(abs(dzq(ij,l)),dzqmax(l)),dzq(ij,l))

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

    r2311 r5117  
    11module misc_mod
    2   integer,save :: itaumax
     2  INTEGER,save :: itaumax
    33  logical,save :: adjust
    4   integer,save :: ItCount
     4  INTEGER,save :: ItCount
    55  logical,save :: debug
    66end module misc_mod

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/pentes_ini.f90

    r5116 r5117  
    5858  INTEGER :: ismax,ismin,lati,latf
    5959  EXTERNAL  SSUM, ismin,ismax
    60   logical :: first
     60  LOGICAL :: first
    6161  save first
    6262  !   fin modif
    … …  
    7272  limit = .TRUE.
    7373  pente_max=2
    74   ! if (mode.eq.1.or.mode.eq.3) THEN
    75   ! if (mode.eq.1) THEN
    76   if (mode>=1) THEN
     74  ! if (mode.EQ.1.OR.mode.EQ.3) THEN
     75  ! if (mode.EQ.1) THEN
     76  IF (mode>=1) THEN
    7777    lati=2
    7878    latf=jjm
    … …  
    8080    lati=1
    8181    latf=jjp1
    82   endif
     82  ENDIF
    8383
    8484  qmin=0.4995
    … …  
    110110    ENDDO
    111111
    112   endif
     112  ENDIF
    113113  !   Fin modif Fred
    114114
    … …  
    245245        sx(1,jjp1,l)=sx(iip1,jjp1,l)
    246246      enddo
    247   endif
    248 
    249   if (mode==4) THEN
     247  ENDIF
     248
     249  IF (mode==4) THEN
    250250     do l=1,llm
    251251        do i=1,iip1
    … …  
    256256        enddo
    257257     enddo
    258   endif
     258  ENDIF
    259259  CALL limx(s0,sx,sm,pente_max)
    260260  ! CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
    261261   CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)
    262262  ! CALL minmaxq(zq,1.e33,-1.e33,'avant advy     ')
    263   if (mode==4) THEN
     263  IF (mode==4) THEN
    264264     do l=1,llm
    265265        do i=1,iip1
    … …  
    270270        enddo
    271271     enddo
    272   endif
     272  ENDIF
    273273   CALL   limy(s0,sy,sm,pente_max)
    274274   CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
    … …  
    282282   CALL limz(s0,sz,sm,pente_max)
    283283   CALL advz( limit,dtvr,w,sm,s0,sx,sy,sz )
    284   if (mode==4) THEN
     284  IF (mode==4) THEN
    285285     do l=1,llm
    286286        do i=1,iip1
    … …  
    291291        enddo
    292292     enddo
    293   endif
     293  ENDIF
    294294    CALL limy(s0,sy,sm,pente_max)
    295295   CALL advy( limit,.5*dtvr,pbarv,sm,s0,sx,sy,sz )
    … …  
    306306
    307307  ! CALL minmaxq(zq,1.e33,-1.e33,'avant advx     ')
    308   if (mode==4) THEN
     308  IF (mode==4) THEN
    309309     do l=1,llm
    310310        do i=1,iip1
    … …  
    315315        enddo
    316316     enddo
    317   endif
     317  ENDIF
    318318   CALL limx(s0,sx,sm,pente_max)
    319319   CALL advx( limit,.5*dtvr,pbaru,sm,s0,sx,sy,sz,lati,latf)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/ppm3d.f90

    r5116 r5117  
    269269  ! User modifiable parameters
    270270  !
    271   integer,parameter :: Jmax = 361, kmax = 150
     271  INTEGER,parameter :: Jmax = 361, kmax = 150
    272272  !
    273273  ! ****6***0*********0*********0*********0*********0*********0**********72
    … …  
    282282  INTEGER :: IMRD2
    283283  REAL :: PT
    284   logical :: cross, fill, dum
     284  LOGICAL :: cross, fill, dum
    285285  !
    286286  ! Local dynamic arrays
    … …  
    327327    WRITE(6,*) 'NLAY must be >= 6'
    328328    stop
    329   endif
    330   if (JNP<NLAY) THEN
     329  ENDIF
     330  IF (JNP<NLAY) THEN
    331331     WRITE(6,*) 'JNP must be >= NLAY'
    332332    stop
    333   endif
     333  ENDIF
    334334  IMRD2=mod(IMR,2)
    335   if (j1==2.and.IMRD2/=0) THEN
     335  IF (j1==2.AND.IMRD2/=0) THEN
    336336     WRITE(6,*) 'if j1=2 IMR must be an even integer'
    337337    stop
    338   endif
    339 
    340   !
    341   IF(Jmax<JNP .or. Kmax<NLAY) THEN
     338  ENDIF
     339
     340  !
     341  IF(Jmax<JNP .OR. Kmax<NLAY) THEN
    342342    WRITE(6,*) 'Jmax or Kmax is too small'
    343343    stop
    344   endif
     344  ENDIF
    345345  !
    346346  DO k=1,NLAY
    … …  
    359359  ! Define cosine consistent with GEOS-GCM (using dycore2.0 or later)
    360360        CALL cosc(cosp,cose,JNP,PI,DP)
    361   endif
     361  ENDIF
    362362  !
    363363  do J=2,JMR
    … …  
    370370  acosp(1)   = RCAP
    371371  acosp(JNP) = RCAP
    372   endif
     372  ENDIF
    373373  !
    374374  IF(NDT0 /= NDT) THEN
    … …  
    384384  IF(MaxDT < abs(NDT)) THEN
    385385        WRITE(6,*) 'Warning!!! NDT maybe too large!'
    386   endif
     386  ENDIF
    387387  !
    388388  IF(CR1>=0.95) THEN
    … …  
    398398  IML = min(6*JS0/(J1-1)+2, 4*IMR/5)
    399399  JN0 = JNP-JS0+1
    400   endif
     400  ENDIF
    401401  !
    402402  !
    … …  
    414414  !
    415415  !  WRITE(6,*) 'J1=',J1,' J2=', J2
    416   endif
     416  ENDIF
    417417  !
    418418  ! *********** End Initialization **********************
    … …  
    438438  END DO
    439439  END DO
    440   endif
     440  ENDIF
    441441  !
    442442  ! Compute "tracer density"
    … …  
    472472  CRY(i,2) = DTDY*V(i,1,k)
    473473  END DO
    474   endif
     474  ENDIF
    475475  !
    476476  ! Determine JS and JN
    … …  
    483483        JS = j
    484484        go to 2222
    485   endif
     485  ENDIF
    486486  enddo
    487487  enddo
    … …  
    493493        JN = j
    494494        go to 2233
    495   endif
     495  ENDIF
    496496  enddo
    497497  enddo
    … …  
    503503  DPI(i,JMR,k) = 0.
    504504  enddo
    505   endif
     505  ENDIF
    506506  !
    507507  ! ******* Compute horizontal mass fluxes ************
    … …  
    596596  VA(IMR,1)=VA(1,1)
    597597  VA(IMR,JNP)=VA(1,JNP)
    598   endif
     598  ENDIF
    599599  !
    600600  ! ****6***0*********0*********0*********0*********0*********0**********72
    … …  
    608608  ! E-W advective cross term
    609609  do j=J1,J2
    610   IF(J>JS  .and. J<JN) GO TO 250
     610  IF(J>JS  .AND. J<JN) GO TO 250
    611611  !
    612612  do i=1,IMR
    … …  
    627627  else
    628628  wk1(i,j,1) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
    629   endif
     629  ENDIF
    630630  wk1(i,j,1) = wk1(i,j,1) - qtmp(i)
    631631  END DO
    … …  
    648648  enddo
    649649  enddo
    650   endif
     650  ENDIF
    651651  ! ****6***0*********0*********0*********0*********0*********0**********72
    652652  ! Contribution from the N-S advection
    … …  
    681681  enddo
    682682  enddo
    683   endif
     683  ENDIF
    684684  !
    685685  CALL xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ(1,1,k,IC),wk1(1,1,2) &
    … …  
    773773  END DO
    774774  END DO
    775   endif
     775  ENDIF
    776776  END DO
    777777  !
    … …  
    783783  END DO
    784784  END DO
    785   endif
     785  ENDIF
    786786  !
    787787  RETURN
    … …  
    792792        flux,wk1,wk2,wz2,delp,KORD)
    793793  IMPLICIT NONE
    794   integer,parameter :: kmax = 150
    795   real,parameter :: R23 = 2./3., R3 = 1./3.
     794  INTEGER,parameter :: kmax = 150
     795  REAL,parameter :: R23 = 2./3., R3 = 1./3.
    796796  INTEGER :: IMR,JNP,NLAY,J1,KORD
    797797  REAL :: WZ(IMR,JNP,NLAY),P(IMR,JNP,NLAY),DC(IMR,JNP,NLAY), &
    … …  
    838838  !
    839839  DO j=1,JNP
    840   if((j==2 .or. j==JMR) .and. j1/=2) goto 2000
     840  IF((j==2 .OR. j==JMR) .AND. j1/=2) goto 2000
    841841  !
    842842  DO k=1,NLAY
    … …  
    942942    flux(i,2) = AL(i,2)+0.5*CP*(AL(i,2)-AR(i,2)-A6(i,2)*(1.+R23*CP))
    943943     ! print *,'test2',i, AL(i,2),AR(i,2),A6(i,2),R23
    944   endif
     944  ENDIF
    945945  END DO
    946946  !
    … …  
    990990  enddo
    991991  !
    992   IF(j>=JN .or. j<=JS) goto 2222
     992  IF(j>=JN .OR. j<=JS) goto 2222
    993993  ! ************* Eulerian **********
    994994  !
    … …  
    998998  qtmp(IMP+1) = q(2,J)
    999999  !
    1000   IF(IORD==1 .or. j==j1 .or. j==j2) THEN
     1000  IF(IORD==1 .OR. j==j1 .OR. j==j2) THEN
    10011001  DO i=1,IMR
    10021002  iu = REAL(i) - uc(i,j)
    … …  
    10071007  DC(0) = DC(IMR)
    10081008  !
    1009   IF(IORD==2 .or. j<=j1vl .or. j>=j2vl) THEN
     1009  IF(IORD==2 .OR. j<=j1vl .OR. j>=j2vl) THEN
    10101010  DO i=1,IMR
    10111011  iu = REAL(i) - uc(i,j)
    … …  
    10141014  else
    10151015  CALL fxppm(IMR,IML,UC(1,j),Qtmp,DC,fx1,IORD)
    1016   endif
     1016  ENDIF
    10171017  !
    10181018  ENDIF
    … …  
    10331033  enddo
    10341034  !
    1035   IF(IORD==1 .or. j==j1 .or. j==j2) THEN
     1035  IF(IORD==1 .OR. j==j1 .OR. j==j2) THEN
    10361036  DO i=1,IMR
    10371037  itmp = INT(uc(i,j))
    … …  
    10681068    enddo
    10691069  !DIR$ VECTOR
    1070   endif
     1070  ENDIF
    10711071  END DO
    10721072  do i=1,IMR
    … …  
    10911091  INTEGER :: IMR,IML,IORD
    10921092  REAL :: UT,P,DC,flux
    1093   real,parameter ::  R3 = 1./3., R23 = 2./3.
     1093  REAL,parameter ::  R3 = 1./3., R23 = 2./3.
    10941094  DIMENSION UT(*),flux(*),P(-IML:IMR+IML+1),DC(-IML:IMR+IML+1)
    10951095  REAL :: AR(0:IMR),AL(0:IMR),A6(0:IMR)
    10961096  INTEGER :: LMT,IMP,JLVL,i
    1097    ! logical first
     1097   ! LOGICAL first
    10981098   ! data first /.TRUE./
    10991099   ! SAVE LMT
    … …  
    11121112  !  else
    11131113  !        LMT = IORD - 3
    1114   !  endif
     1114  !  ENDIF
    11151115  !
    11161116  LMT = IORD - 3
    11171117   ! WRITE(6,*) 'PPM option in E-W direction = ', LMT
    11181118   ! first = .FALSE.
    1119    ! endif
     1119   ! END IF
    11201120  !
    11211121  DO i=1,IMR
    … …  
    11451145  flux(i) = AL(i) - 0.5*UT(i)*(AR(i) - AL(i) + &
    11461146        A6(i)*(1.+R23*UT(i)))
    1147   endif
     1147  ENDIF
    11481148  enddo
    11491149  RETURN
    … …  
    11531153  IMPLICIT NONE
    11541154  INTEGER :: IMR,IML
    1155   real,parameter :: R24 = 1./24.
     1155  REAL,parameter :: R24 = 1./24.
    11561156  REAL :: P(-IML:IMR+1+IML),DC(-IML:IMR+1+IML)
    11571157  INTEGER :: i
    … …  
    11911191  CALL ymist(IMR,JNP,j1,P,DC2,4)
    11921192  !
    1193   IF(JORD<=0 .or. JORD>=3) THEN
     1193  IF(JORD<=0 .OR. JORD>=3) THEN
    11941194  CALL fyppm(VC,P,DC2,fx,IMR,JNP,j1,j2,A6,AR,AL,JORD)
    11951195
    … …  
    11991199  fx(i,j1) = p(i,JT) + (sign(1.,VC(i,j1))-VC(i,j1))*DC2(i,JT)
    12001200  END DO
    1201   endif
    1202   endif
     1201  ENDIF
     1202  ENDIF
    12031203  !
    12041204  DO i=1,len
    … …  
    12321232  DQ(i,JMR) = sum2
    12331233  enddo
    1234   endif
     1234  ENDIF
    12351235  !
    12361236  RETURN
    … …  
    12401240  IMPLICIT NONE
    12411241  INTEGER :: IMR,JNP,j1,ID
    1242   real,parameter :: R24 = 1./24.
     1242  REAL,parameter :: R24 = 1./24.
    12431243  REAL :: P(IMR,JNP),DC(IMR,JNP)
    12441244  INTEGER :: iimh,jmr,ijm3,imh,i
    … …  
    13151315  DC(i,JNP) =  - DC(i-imh,JNP)
    13161316  END DO
    1317   endif
     1317  ENDIF
    13181318  RETURN
    13191319END SUBROUTINE ymist
    … …  
    13221322  IMPLICIT NONE
    13231323  INTEGER :: IMR,JNP,j1,j2,JORD
    1324   real,parameter :: R3 = 1./3., R23 = 2./3.
     1324  REAL,parameter :: R3 = 1./3., R23 = 2./3.
    13251325  REAL :: VC(IMR,*),flux(IMR,*),P(IMR,*),DC(IMR,*)
    13261326  ! Local work arrays.
    … …  
    13281328  INTEGER :: LMT,i
    13291329  INTEGER :: IMH,JMR,j11,IMJM1,len
    1330    ! logical first
     1330   ! LOGICAL first
    13311331   ! data first /.TRUE./
    13321332   ! SAVE LMT
    … …  
    13481348   ! else
    13491349   !       LMT = JORD - 3
    1350    ! endif
     1350   ! END IF
    13511351  !
    13521352  !  first = .FALSE.
    1353   !  endif
     1353  !  ENDIF
    13541354  !
    13551355  ! modifs pour pouvoir choisir plusieurs schemas PPM
    … …  
    13941394  flux(i,j1) = AL(i,j1) - 0.5*VC(i,j1)*(AR(i,j1) - AL(i,j1) + &
    13951395        A6(i,j1)*(1.+R23*VC(i,j1)))
    1396   endif
     1396  ENDIF
    13971397  END DO
    13981398  RETURN
    … …  
    14981498    JMR = JNP-1
    14991499  do j=j1,j2
    1500   IF(J>JS  .and. J<JN) GO TO 1309
     1500  IF(J>JS  .AND. J<JN) GO TO 1309
    15011501  !
    15021502  do i=1,IMR
    … …  
    15271527  else
    15281528  adx(i,j) = qtmp(iiu)+ru*(qtmp(iiu)-qtmp(iiu+1))
    1529   endif
     1529  ENDIF
    15301530  enddo
    15311531  ENDIF
    … …  
    15981598  ! LMT = 2: POSITIVE-DEFINITE CONSTRAINT
    15991599  !
    1600   real,parameter :: R12 = 1./12.
     1600  REAL,parameter :: R12 = 1./12.
    16011601  REAL :: A6(IM),AR(IM),AL(IM),P(IM),DC(IM)
    16021602  INTEGER :: IM,LMT
    … …  
    16211621        A6(i) = 3.*(AR(i)-p(i))
    16221622        AL(i) = AR(i) - A6(i)
    1623   endif
    1624   endif
     1623  ENDIF
     1624  ENDIF
    16251625  END DO
    16261626  elseif(LMT==1) THEN
    … …  
    16281628  do i=1,IM
    16291629  IF(abs(AR(i)-AL(i)) >= -A6(i)) go to 150
    1630   IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
     1630  IF(p(i)<AR(i) .AND. p(i)<AL(i)) THEN
    16311631        AR(i) = p(i)
    16321632        AL(i) = p(i)
    … …  
    16381638        A6(i) = 3.*(AR(i)-p(i))
    16391639        AL(i) = AR(i) - A6(i)
    1640   endif
     1640  ENDIF
    16411641150   continue
    16421642  END DO
    … …  
    16461646  fmin = p(i) + 0.25*(AR(i)-AL(i))**2/A6(i) + A6(i)*R12
    16471647  IF(fmin>=0.) go to 250
    1648   IF(p(i)<AR(i) .and. p(i)<AL(i)) THEN
     1648  IF(p(i)<AR(i) .AND. p(i)<AL(i)) THEN
    16491649        AR(i) = p(i)
    16501650        AL(i) = p(i)
    … …  
    16561656        A6(i) = 3.*(AR(i)-p(i))
    16571657        AL(i) = AR(i) - A6(i)
    1658   endif
     1658  ENDIF
    16591659250   continue
    16601660  END DO
    1661   endif
     1661  ENDIF
    16621662  RETURN
    16631663END SUBROUTINE lmtppm
    … …  
    17081708   cose(j) =  cose(JNP+2-j)
    17091709   enddo
    1710   endif
     1710  ENDIF
    17111711  !
    17121712  do j=2,JMR
    … …  
    17461746        cross,IC,NSTEP)
    17471747  !
    1748   real,parameter :: tiny = 1.E-60
     1748  REAL,parameter :: tiny = 1.E-60
    17491749  INTEGER :: IMR,JNP,NLAY,j1,j2,IC,NSTEP
    17501750  REAL :: Q(IMR,JNP,NLAY),qtmp(IMR,JNP),cosp(*),acosp(*)
    1751   logical :: cross
     1751  LOGICAL :: cross
    17521752  INTEGER :: NLAYM1,len,ip,L,icr,ipy,ipx,i
    17531753  REAL :: qup,qly,dup,sum
    … …  
    17671767  IF(cross) THEN
    17681768  CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    1769   endif
     1769  ENDIF
    17701770  IF(icr==0) goto 50
    17711771  !
    … …  
    17761776      Q(i,j1,2) = Q(i,j1,2) + Q(i,j1,1)
    17771777      Q(i,j1,1) = 0.
    1778   endif
     1778  ENDIF
    17791779  enddo
    17801780  !
    … …  
    17891789  IF(cross) THEN
    17901790  CALL filcr(q(1,1,L),IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    1791   endif
     1791  ENDIF
    17921792  IF(icr==0) goto 225
    17931793  !
    … …  
    18431843  WRITE(6,*) 'IC=',IC,' STEP=',NSTEP, &
    18441844        ' Vertical filling pts=',ip
    1845   endif
     1845  ENDIF
    18461846  !
    18471847  IF(sum>1.e-25) THEN
    18481848  WRITE(6,*) IC,NSTEP,' Mass source from the ground=',sum
    1849   endif
     1849  ENDIF
    18501850  RETURN
    18511851END SUBROUTINE qckxyz
    … …  
    18751875  q(i+1,j-1) = (ds - d2)*acosp(j-1)
    18761876  q(i,j) = (d2 - dq)*acosp(j) + tiny
    1877   endif
    1878   END DO
    1879   IF(icr==0 .and. q(IMR,j)>=0.) goto 65
     1877  ENDIF
     1878  END DO
     1879  IF(icr==0 .AND. q(IMR,j)>=0.) goto 65
    18801880  DO i=2,IMR
    18811881  IF(q(i,j)<0.) THEN
    … …  
    18941894  q(i-1,j-1) = (ds - d2)*acosp(j-1)
    18951895  q(i,j) = (d2 - dq)*acosp(j) + tiny
    1896   endif
     1896  ENDIF
    18971897  END DO
    18981898  ! *****************************************
    … …  
    19141914  q(IMR,j-1) = (ds - d2)*acosp(j-1)
    19151915  q(i,j) = (d2 - dq)*acosp(j) + tiny
    1916   endif
     1916  ENDIF
    19171917  ! *****************************************
    19181918  ! i=IMR
    … …  
    19331933  q(1,j-1) = (ds - d2)*acosp(j-1)
    19341934  q(i,j) = (d2 - dq)*acosp(j) + tiny
    1935   endif
     1935  ENDIF
    19361936  ! *****************************************
    1937193765   continue
    … …  
    19391939  !
    19401940  do i=1,IMR
    1941   IF(q(i,j1)<0. .or. q(i,j2)<0.) THEN
     1941  IF(q(i,j1)<0. .OR. q(i,j2)<0.) THEN
    19421942  icr = 1
    19431943  goto 80
    1944   endif
     1944  ENDIF
    19451945  enddo
    19461946  !
    1947194780   continue
    19481948  !
    1949   IF(q(1,1)<0. .or. q(1,jnp)<0.) THEN
     1949  IF(q(1,1)<0. .OR. q(1,jnp)<0.) THEN
    19501950  icr = 1
    1951   endif
     1951  ENDIF
    19521952  !
    19531953  RETURN
    … …  
    19601960  REAL :: DP,CAP1,dq,dn,d0,d1,ds,d2
    19611961  INTEGER :: i,j
    1962    ! logical first
     1962   ! LOGICAL first
    19631963   ! data first /.TRUE./
    19641964   ! save cap1
    … …  
    19681968  CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
    19691969   ! first = .FALSE.
    1970    ! endif
     1970   ! END IF
    19711971  !
    19721972  ipy = 0
    … …  
    19881988  q(i,j-1) = (ds - d2)*acosp(j-1)
    19891989  q(i,j) = (d2 - dq)*acosp(j) + tiny
    1990   endif
     1990  ENDIF
    19911991  END DO
    19921992  END DO
    … …  
    20022002  q(i,j1+1) = (dn - d1)*acosp(j1+1)
    20032003  q(i,j1) = (d1 - dq)*acosp(j1) + tiny
    2004   endif
     2004  ENDIF
    20052005  enddo
    20062006  !
    … …  
    20162016  q(i,j-1) = (ds - d2)*acosp(j-1)
    20172017  q(i,j) = (d2 - dq)*acosp(j) + tiny
    2018   endif
     2018  ENDIF
    20192019  enddo
    20202020  !
    … …  
    20272027  IF(q(i,j1)<0.) ipy = 1
    20282028  enddo
    2029   endif
     2029  ENDIF
    20302030  !
    20312031  IF(q(1,JNP)<0.) THEN
    … …  
    20362036  IF(q(i,j2)<0.) ipy = 1
    20372037  enddo
    2038   endif
     2038  ENDIF
    20392039  !
    20402040  RETURN
    … …  
    20702070  qtmp(j,i+1) = qtmp(j,i+1) - d2
    20712071  qtmp(j,i) = qtmp(j,i) + d2 + tiny
    2072   endif
     2072  ENDIF
    20732073  END DO
    20742074  END DO
    … …  
    20892089  !
    20902090  qtmp(j,i) = qtmp(j,i) + d2 + tiny
    2091   endif
     2091  ENDIF
    20922092  END DO
    20932093  i=IMR
    … …  
    21062106  !
    21072107  qtmp(j,i) = qtmp(j,i) + d2 + tiny
    2108   endif
     2108  ENDIF
    21092109  END DO
    21102110  !
    … …  
    21182118  !
    21192119  ! Poles.
    2120   IF(q(1,1)<0 .or. q(1,JNP)<0.) ipx = 1
    2121   endif
     2120  IF(q(1,1)<0 .OR. q(1,JNP)<0.) ipx = 1
     2121  ENDIF
    21222122  RETURN
    21232123END SUBROUTINE filew

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/prather.f90

    r5116 r5117  
    6262  INTEGER :: ismax,ismin
    6363  EXTERNAL  SSUM, ismin,ismax
    64   logical :: first
     64  LOGICAL :: first
    6565  save first
    6666  EXTERNAL advxp,advyp,advzp
    … …  
    109109    ENDDO
    110110    ENDDO
    111   endif
     111  ENDIF
    112112  !   Fin modif Fred
    113113

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

    r5116 r5117  
    1111    ! xprimm.
    1212
    13     use nrtype, ONLY: twopi
    14     use serre_mod, ONLY: clon
     13    USE lmdz_physical_constants, ONLY: twopi
     14    USE serre_mod, ONLY: clon
    1515
    1616    include "dimensions.h"
    1717    ! for iim
    1818
    19     integer, intent(in):: is2
    20     real, intent(inout):: xlon(:), xprimm(:) ! (iim + 1)
     19    INTEGER, INTENT(IN):: is2
     20    REAL, INTENT(INOUT):: xlon(:), xprimm(:) ! (iim + 1)
    2121
    2222    !-----------------------------------------------------
    2323
    24     if (is2 /= 0) THEN
     24    IF (is2 /= 0) THEN
    2525       IF (clon <= 0.) THEN
    2626          IF (is2 /= 1) THEN

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/sortvarc.f90

    r5116 r5117  
    7070  ! Ehouarn: when no initialization fields from file, resetvarc should be
    7171       ! set to false
    72    if (firstcal) THEN
    73      if (.not.read_start) THEN
     72   IF (firstcal) THEN
     73     IF (.NOT.read_start) THEN
    7474       resetvarc=.TRUE.
    7575     endif
    … …  
    147147  ang   = SSUM(     llm,  angl, 1 )
    148148
    149   IF (firstcal.and.resetvarc) THEN
     149  IF (firstcal.AND.resetvarc) THEN
    150150     WRITE(lunout,3500) itau, rjour, heure, time
    151151     WRITE(lunout,*) trim(modname), &
    … …  
    162162  ! compute relative changes in etot,... (except if 'reference' values
    163163  ! are zero, which can happen when using iniacademic)
    164   if (etot0/=0) THEN
     164  IF (etot0/=0) THEN
    165165    etot= etot/etot0
    166166  else
    167167    etot=1.
    168   endif
     168  ENDIF
    169169  rmsv= SQRT(rmsv/ptot)
    170   if (ptot0/=0) THEN
     170  IF (ptot0/=0) THEN
    171171    ptot= ptot/ptot0
    172172  else
    173173    ptot=1.
    174   endif
    175   if (ztot0/=0) THEN
     174  ENDIF
     175  IF (ztot0/=0) THEN
    176176    ztot= ztot/ztot0
    177177  else
    178178    ztot=1.
    179   endif
    180   if (stot0/=0) THEN
     179  ENDIF
     180  IF (stot0/=0) THEN
    181181    stot= stot/stot0
    182182  else
    183183    stot=1.
    184   endif
    185   if (ang0/=0) THEN
     184  ENDIF
     185  IF (ang0/=0) THEN
    186186    ang = ang /ang0
    187187  else
    188188    ang=1.
    189   endif
     189  ENDIF
    190190
    191191  firstcal = .FALSE.

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/test_period.f90

    r5116 r5117  
    4343
    4444     do ij=1,iim
    45       if (teta(ij,l)/=teta(1,l) &
    46             .or.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN
     45      IF (teta(ij,l)/=teta(1,l) &
     46            .OR.teta(ip1jm+ij,l)/=teta(ip1jm+1,l) ) THEN
    4747      PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', &
    4848            ' constant aux poles ! '
    … …  
    9999     ENDDO
    100100     do ij=1,iim
    101       if (p(ij,l)/=p(1,l) &
    102             .or.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) THEN
     101      IF (p(ij,l)/=p(1,l) &
     102            .OR.p(ip1jm+ij,l)/=p(ip1jm+1,l) ) THEN
    103103      PRINT *,'STOP dans test_period car ---  P     ---  n est pas', &
    104104            ' constant aux poles ! '

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/tracstoke.h

    r5099 r5117  
    33
    44      common /tracstoke/istdyn,istphy,unittrac
    5       integer istdyn,istphy,unittrac
     5      INTEGER istdyn,istphy,unittrac

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

    r5116 r5117  
    1111  ! levels are pressure levels.
    1212
    13   use comconst_mod, ONLY: omeg, rad
     13  USE comconst_mod, ONLY: omeg, rad
    1414 
    1515  IMPLICIT NONE
    … …  
    1919  include "comgeom2.h"
    2020
    21   real ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
    22   real um(jjm,llm),fact,u(iip1,jjm,llm)
    23   integer i,j,l
     21  REAL ucov(iip1,jjp1,llm),phi(iip1,jjp1,llm)
     22  REAL um(jjm,llm),fact,u(iip1,jjm,llm)
     23  INTEGER i,j,l
    2424
    25   real zlat
     25  REAL zlat
    2626
    2727  um(:,:)=0 ! initialize um()
    … …  
    2929  DO j=1,jjm
    3030
    31      if (abs(sin(rlatv(j)))<1.e-4) THEN
     31     IF (abs(sin(rlatv(j)))<1.e-4) THEN
    3232        zlat=1.e-4
    3333     else

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/write_grads_dyn.h

    r5116 r5117  
    22! $Header$
    33
    4 if (callinigrads) THEN
     4IF (callinigrads) THEN
    55   string10='dyn'
    66   CALL inigrads(1,iip1 &

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

    r5116 r5117  
    55  USE ioipsl
    66  USE infotrac, ONLY: nqtot
    7   use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
     7  USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
    88  USE comconst_mod, ONLY: cpp
    99  USE temps_mod, ONLY: itau_dyn
    … …  
    4747  !   Variables locales
    4848
    49   integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
     49  INTEGER ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
    5050  INTEGER iq, ii, ll
    51   real tm(ip1jmp1*llm)
     51  REAL tm(ip1jmp1*llm)
    5252  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
    53   logical ok_sync
    54   integer itau_w
     53  LOGICAL ok_sync
     54  INTEGER itau_w
    5555
    5656  !-----------------------------------------------------------------
    … …  
    120120  ! CALL histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    121121
    122   if (ok_sync) THEN
     122  IF (ok_sync) THEN
    123123     CALL histsync(histaveid)
    124124     CALL histsync(histvaveid)

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/writehist.f90

    r5116 r5117  
    5555  INTEGER :: iq, ii, ll
    5656  INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
    57   logical :: ok_sync
     57  LOGICAL :: ok_sync
    5858  INTEGER :: itau_w
    5959  REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)
    … …  
    114114  !  Fin
    115115  !
    116   if (ok_sync) THEN
     116  IF (ok_sync) THEN
    117117    CALL histsync(histid)
    118118    CALL histsync(histvid)
    119119    CALL histsync(histuid)
    120   endif
     120  ENDIF
    121121  RETURN
    122122END SUBROUTINE writehist
Note: See TracChangeset for help on using the changeset viewer.