Ignore:
Timestamp:
Jul 23, 2024, 3:29:36 PM (4 months ago)
Author:
abarral
Message:

Handle CPP_INLANDSIS in lmdz_cppkeys_wrapper.F90
Remove obsolete key wrgrads_thermcell, _ADV_HALO, _ADV_HALLO, isminmax
Remove redundant uses of CPPKEY_INCA (thanks acozic)
Remove obsolete misc/write_field.F90
Remove unused ioipsl_* wrappers
Remove calls to WriteField_u with wrong signature
Convert .F -> .[fF]90
(lint) uppercase fortran operators
[note: 1d and iso still broken - working on it]

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
45 edited
1 moved

Legend:

Unmodified
Added
Removed

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

    r5099 r5103  
    22! $Id$
    33
    4       subroutine adaptdt(nadv,dtbon,n,pbaru,
     4      SUBROUTINE adaptdt(nadv,dtbon,n,pbaru,
    55     c                   masse)
    66

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

    r5101 r5103  
    300300            zqv(ij,l)=q(ij,l)
    301301            zqv(ip1jm-iip1+ij,l)=q(ip1jm+ij,l)
    302             extremum(ij)=.true.
    303             extremum(ip1jmp1-iip1+ij)=.true.
     302            extremum(ij)=.TRUE.
     303            extremum(ip1jmp1-iip1+ij)=.TRUE.
    304304         enddo
    305305
    … …  
    404404            zqw(ij,2)=q(ij,1)
    405405            zqw(ij,llm)=q(ij,llm)
    406             extremum(ij,1)=.true.
    407             extremum(ij,llm)=.true.
     406            extremum(ij,1)=.TRUE.
     407            extremum(ij,llm)=.TRUE.
    408408         enddo
    409409
    … …  
    502502               zdq=qd(ij,l)-qg(ij,l)
    503503c              if((qd(ij,l)-q(ij,l))*(q(ij,l)-qg(ij,l)).lt.0.) then
    504 c                 print*,'probleme au point ij=',ij,'  l=',l
    505 c                 print*,qd(ij,l),q(ij,l),qg(ij,l)
     504c                 PRINT*,'probleme au point ij=',ij,'  l=',l
     505c                 PRINT*,qd(ij,l),q(ij,l),qg(ij,l)
    506506c                 qd(ij,l)=q(ij,l)
    507507c                 qg(ij,l)=q(ij,l)
    … …  
    512512c                 if(.not.(zsigd(ij,l).ge.0..and.zsigd(ij,l).le.1. .and.
    513513c    s               zsigg(ij,l).ge.0..or.zsigg(ij,l).le.1.) ) then
    514 c                    print*,'probleme au point ij=',ij,'  l=',l
    515 c                    print*,'sigg=',zsigg(ij,l),'  sigd=',zsigd(ij,l)
    516 c                    print*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq
     514c                    PRINT*,'probleme au point ij=',ij,'  l=',l
     515c                    PRINT*,'sigg=',zsigg(ij,l),'  sigd=',zsigd(ij,l)
     516c                    PRINT*,'q d,c,g ',qd(ij,l),q(ij,l),qg(ij,l),zdq
    517517c                    stop
    518518c                 endif
    … …  
    566566          endif
    567567c         if(zsig.lt.0.) then
    568 c            print*,'au point ij=',ij,'  l=',l,'  sig=',zsig
     568c            PRINT*,'au point ij=',ij,'  l=',l,'  sig=',zsig
    569569c            stop
    570570c         endif
    … …  
    611611               enddo
    612612               niju=iju
    613 c              print*,'niju,nl',niju,nl(l)
     613c              PRINT*,'niju,nl',niju,nl(l)
    614614
    615615c  traitement des mailles
    … …  
    759759               zdq=qn(ij,l)-qs(ij,l)
    760760c              if((qn(ij,l)-q(ij,l))*(q(ij,l)-qs(ij,l)).lt.0.) then
    761 c                 print*,'probleme au point ij=',ij,'  l=',l,'  advnqx'
    762 c                 print*,qn(ij,l),q(ij,l),qs(ij,l)
     761c                 PRINT*,'probleme au point ij=',ij,'  l=',l,'  advnqx'
     762c                 PRINT*,qn(ij,l),q(ij,l),qs(ij,l)
    763763c                 qn(ij,l)=q(ij,l)
    764764c                 qs(ij,l)=q(ij,l)
    … …  
    769769c                 if(.not.(zsign(ij).ge.0..and.zsign(ij).le.1. .and.
    770770c    s               zsigs(ij).ge.0..or.zsigs(ij).le.1.) ) then
    771 c                    print*,'probleme au point ij=',ij,'  l=',l
    772 c                    print*,'sigs=',zsigs(ij),'  sign=',zsign(ij)
     771c                    PRINT*,'probleme au point ij=',ij,'  l=',l
     772c                    PRINT*,'sigs=',zsigs(ij),'  sign=',zsign(ij)
    773773c                    stop
    774774c                 endif
    … …  
    886886               zdq=qb(ij,l)-qh(ij,l)
    887887c              if((qh(ij,l)-q(ij,l))*(q(ij,l)-qb(ij,l)).lt.0.) then
    888 c                 print*,'probleme au point ij=',ij,'  l=',l
    889 c                 print*,qh(ij,l),q(ij,l),qb(ij,l)
     888c                 PRINT*,'probleme au point ij=',ij,'  l=',l
     889c                 PRINT*,qh(ij,l),q(ij,l),qb(ij,l)
    890890c                 qh(ij,l)=q(ij,l)
    891891c                 qb(ij,l)=q(ij,l)
    … …  
    903903       enddo
    904904
    905 c      print*,'ok1'
     905c      PRINT*,'ok1'
    906906c   calcul de la pente maximum dans la maille en valeur absolue
    907907       do l=2,llm
    … …  
    947947         enddo
    948948      enddo
    949 c     print*,'ok3'
     949c     PRINT*,'ok3'
    950950      RETURN
    951951      END

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

    r5099 r5103  
    5959
    6060C  Rem : VGRI et WGRI ne sont pas utilises dans
    61 C  cette subroutine ( advection en x uniquement )
     61C  cette SUBROUTINE ( advection en x uniquement )
    6262C
    6363C  Ti are the moments for the current latitude and level
    … …  
    461461c            PRINT*,'SM(',i,j,l,')=',SM(i,j,l)
    462462c            PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    463 c            print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
    464 c            print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
    465 c            print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
     463c            PRINT*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
     464c            PRINT*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
     465c            PRINT*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
    466466c            WRITE (*,*) 'On arrete !! - pbl en fin de ADVX1'
    467467cc            STOP

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

    r5099 r5103  
    5151
    5252C  Rem : VGRI et WGRI ne sont pas utilises dans
    53 C  cette subroutine ( advection en x uniquement )
     53C  cette SUBROUTINE ( advection en x uniquement )
    5454C
    5555C
    … …  
    101101c         IF (S0(i,j,l,ntra) .lt. 0. ) THEN
    102102c         PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    103 c             print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
    104 c         print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
    105 c         print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
     103c             PRINT*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
     104c         PRINT*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
     105c         PRINT*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
    106106c         PRINT*, 'AIE !! debut ADVXP - pbl arg. passage dans ADVXP'
    107107cc            STOP
    … …  
    618618c                PRINT*, 'En fin de ADVXP'
    619619c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    620 c                print*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
    621 c           print*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
    622 c               print*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
     620c                PRINT*, 'SSX(',i,j,l,')=',SSX(i,j,l,ntra)
     621c           PRINT*, 'SY(',i,j,l,')=',SY(i,j,l,ntra)
     622c               PRINT*, 'SZ(',i,j,l,')=',SZ(i,j,l,ntra)
    623623c            WRITE (*,*) 'On arrete !! - pbl en fin de ADVXP'
    624624c            STOP

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

    r5099 r5103  
    6464
    6565C  Rem : UGRI et WGRI ne sont pas utilises dans
    66 C  cette subroutine ( advection en y uniquement )
     66C  cette SUBROUTINE ( advection en y uniquement )
    6767C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
    6868C

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

    r5099 r5103  
    7171
    7272C  Rem : UGRI et WGRI ne sont pas utilises dans
    73 C  cette subroutine ( advection en y uniquement )
     73C  cette SUBROUTINE ( advection en y uniquement )
    7474C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
    7575C
    … …  
    229229C
    230230      END DO
    231 c     print*,'ADVYP 21'
     231c     PRINT*,'ADVYP 21'
    232232C
    233233      DO JV=1,NTRA
    … …  
    276276C  puts the temporary moments Fi into appropriate neighboring boxes
    277277C
    278 c     print*,'av ADVYP 25'
     278c     PRINT*,'av ADVYP 25'
    279279      DO I=1,LON
    280280C
    … …  
    291291C
    292292      END DO
    293 c     print*,'av ADVYP 25'
     293c     PRINT*,'av ADVYP 25'
    294294C
    295295      DO JV=1,NTRA
    … …  
    317317C  flux from KP to K if V(K).lt.0 and from K to KP if V(K).gt.0
    318318C
    319 c     print*,'av ADVYP 30'
     319c     PRINT*,'av ADVYP 30'
    320320      DO K=1,LAT-1
    321321      KP=K+1
    … …  
    341341      END DO
    342342      END DO
    343 c     print*,'ap ADVYP 30'
     343c     PRINT*,'ap ADVYP 30'
    344344C
    345345      DO JV=1,NTRA
    … …  
    409409      END DO
    410410      END DO
    411 c     print*,'ap ADVYP 31'
     411c     PRINT*,'ap ADVYP 31'
    412412C
    413413C  puts the temporary moments Fi into appropriate neighboring boxes
    … …  
    433433      END DO
    434434      END DO
    435 c     print*,'ap ADVYP 32'
     435c     PRINT*,'ap ADVYP 32'
    436436C
    437437      DO JV=1,NTRA
    … …  
    481481      END DO
    482482      END DO
    483 c     print*,'ap ADVYP 33'
     483c     PRINT*,'ap ADVYP 33'
    484484C
    485485C  traitement special pour le pole Sud (idem pole Nord)
    … …  
    509509C
    510510      END DO
    511 c     print*,'ap ADVYP 41'
     511c     PRINT*,'ap ADVYP 41'
    512512C
    513513      DO JV=1,NTRA
    … …  
    534534      END DO
    535535      END DO
    536 c     print*,'ap ADVYP 42'
     536c     PRINT*,'ap ADVYP 42'
    537537C
    538538      DO I=1,LON
    … …  
    542542         ENDIF
    543543      END DO
    544 c     print*,'ap ADVYP 43'
     544c     PRINT*,'ap ADVYP 43'
    545545C
    546546      DO JV=1,NTRA
    … …  
    568568C
    569569      END DO
    570 c     print*,'ap ADVYP 45'
     570c     PRINT*,'ap ADVYP 45'
    571571C
    572572      DO JV=1,NTRA
    … …  
    587587      END DO
    588588      END DO
    589 c     print*,'ap ADVYP 46'
     589c     PRINT*,'ap ADVYP 46'
    590590C
    591591      END DO
    … …  
    637637      PRINT*,'---------- DIAG DANS ADVY - SORTIE --------'
    638638      PRINT*,'sqf=',sqf
    639 c     print*,'ap ADVYP fin'
     639c     PRINT*,'ap ADVYP fin'
    640640
    641641c-----------------------------------------------------------------

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

    r5099 r5103  
    8686c        IF (S0(i,j,l,ntra) .lt. 0. ) THEN
    8787c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    88 c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
    89 c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
    90 c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
     88c           PRINT*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
     89c           PRINT*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
     90c           PRINT*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
    9191c           PRINT*, 'AIE !! debut ADVZ - pbl arg. passage dans ADVZ'
    9292c            STOP
    … …  
    283283c           PRINT*, 'En fin de ADVZ'
    284284c           PRINT*,'S0(',i,j,l,')=',S0(i,j,l,ntra)
    285 c           print*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
    286 c           print*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
    287 c           print*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
     285c           PRINT*, 'sx(',i,j,l,')=',sx(i,j,l,ntra)
     286c           PRINT*, 'sy(',i,j,l,')=',sy(i,j,l,ntra)
     287c           PRINT*, 'sz(',i,j,l,')=',sz(i,j,l,ntra)
    288288c           WRITE (*,*) 'On arrete !! - pbl en fin de ADVZ1'
    289289c            STOP

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

    r5099 r5103  
    7474
    7575C Rem : UGRI et VGRI ne sont pas utilises dans
    76 C  cette subroutine ( advection en z uniquement )
     76C  cette SUBROUTINE ( advection en z uniquement )
    7777C  Rem 2 :le dimensionnement de VGRI depend de celui de pbarv
    7878C         attention a celui de WGRI

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

    r5099 r5103  
    5151c   -------
    5252c
    53       CALL filtreg( pbern, jjp1, llm, 2,1, .true., 1 )
     53      CALL filtreg( pbern, jjp1, llm, 2,1, .TRUE., 1 )
    5454c
    5555c-----------------------------------------------------------------------

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

    r5099 r5103  
    4949  CALL bernoui  ( ip1jmp1, llm     , phi       , ecin   , bern  )
    5050  DO l=1,llm; ang(:,l) = ucov(:,l) + constang(:); END DO
    51   resetvarc=.true. ! force a recomputation of initial values in sortvarc
     51  resetvarc=.TRUE. ! force a recomputation of initial values in sortvarc
    5252  dp(:)=convm(:,1)/airesurg(:)
    5353  CALL sortvarc( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )

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

    r5101 r5103  
    44SUBROUTINE conf_planete
    55
    6 #ifdef CPP_IOIPSL
    76USE IOIPSL
    8 #else
    9 ! if not using IOIPSL, we still need to use (a local version of) getin
    10 USE ioipsl_getincom
    11 #endif
    127USE comconst_mod, ONLY: pi, g, molmass, kappa, cpp, omeg, rad, &
    138                        year_day, daylen, daysec, ihf

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

    r5101 r5103  
    159159C
    160160C
    161       print*,'MAIS POURQUOI DONC DIAGEDYN NE MARCHE PAS ?'
     161      PRINT*,'MAIS POURQUOI DONC DIAGEDYN NE MARCHE PAS ?'
    162162      return
    163163C     On ne garde les donnees que dans les colonnes i=1,iim

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

    r5101 r5103  
    33SUBROUTINE disvert()
    44
    5 #ifdef CPP_IOIPSL
    65  use ioipsl, only: getin
    7 #else
    8   USE ioipsl_getincom, only: getin
    9 #endif
    106  use new_unit_m, only: new_unit
    117  use assert_m, only: assert
    … …  
    7167     dsigmin=1.
    7268  endif
    73   call getin('dsigmin', dsigmin)
     69  CALL getin('dsigmin', dsigmin)
    7470  WRITE(LUNOUT,*) trim(modname), 'Discretisation verticale DSIGMIN=',dsigmin
    7571
    … …  
    267263!===================================================================
    268264
    269     call getin('vert_scale',vert_scale)
    270     call getin('vert_dzmin',vert_dzmin)
    271     call getin('vert_dzlow',vert_dzlow)
    272     call getin('vert_z0low',vert_z0low)
     265    CALL getin('vert_scale',vert_scale)
     266    CALL getin('vert_dzmin',vert_dzmin)
     267    CALL getin('vert_dzlow',vert_dzlow)
     268    CALL getin('vert_z0low',vert_z0low)
    273269    CALL getin('vert_dzmid',vert_dzmid)
    274270    CALL getin('vert_z0mid',vert_z0mid)
    275     call getin('vert_h_mid',vert_h_mid)
    276     call getin('vert_dzhig',vert_dzhig)
    277     call getin('vert_z0hig',vert_z0hig)
    278     call getin('vert_h_hig',vert_h_hig)
     271    CALL getin('vert_h_mid',vert_h_mid)
     272    CALL getin('vert_dzhig',vert_dzhig)
     273    CALL getin('vert_z0hig',vert_z0hig)
     274    CALL getin('vert_h_hig',vert_h_hig)
    279275
    280276    scaleheight=vert_scale ! for consistency with further computations
    … …  
    314310     ! should be in Pa. First couple of values should correspond to
    315311     ! the surface, that is : "bp" should be in descending order.
    316      call new_unit(unit)
     312     CALL new_unit(unit)
    317313     open(unit, file="hybrid.txt", status="old", action="read", &
    318314          position="rewind")
    … …  
    322318     END DO
    323319     close(unit)
    324      call assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &
     320     CALL assert(ap(1) == 0., ap(llm + 1) == 0., bp(1) == 1., &
    325321          bp(llm + 1) == 0., "disvert: bad ap or bp values")
    326322  case default
    327      call abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
     323     CALL abort_gcm("disvert", 'Wrong value for "vert_sampling"', 1)
    328324  END select
    329325
    … …  
    437433       sg(l)=sg(l)-(c1*sg(l)+f1-sig(l))/(c1+2*f1*sg(l)**(-3))
    438434    ENDDO
    439 !   print*,'SSSSIG ',sig(l),sg(l),c1*sg(l)+exp(1-1./sg(l)**2)*(1.-c1)
     435!   PRINT*,'SSSSIG ',sig(l),sg(l),c1*sg(l)+exp(1-1./sg(l)**2)*(1.-c1)
    440436  ENDDO
    441437  sg(1)=1.; sg(ns)=0.

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

    r5101 r5103  
    66c    On l'utilise aussi pour Venus et Titan, legerment modifiee.
    77
    8 #ifdef CPP_IOIPSL
    98      use IOIPSL
    10 #else
    11 ! if not using IOIPSL, we still need to use (a local version of) getin
    12       use ioipsl_getincom
    13 #endif
    149      USE comvert_mod, ONLY: ap,bp,aps,bps,presnivs,pseudoalt,
    1510     &                       nivsig,nivsigs,pa,preff,scaleheight
    … …  
    5853!      pi=2.*ASIN(1.) ! already done in iniconst
    5954     
    60       hybrid=.true. ! default value for hybrid (ie: use hybrid coordinates)
     55      hybrid=.TRUE. ! default value for hybrid (ie: use hybrid coordinates)
    6156      CALL getin('hybrid',hybrid)
    6257      write(lunout,*) trim(modname),': hybrid=',hybrid
    … …  
    275270
    276271c ************************************************************
    277       subroutine sig_hybrid(sig,pa,preff,newsig)
     272      SUBROUTINE sig_hybrid(sig,pa,preff,newsig)
    278273c     ----------------------------------------------
    279274c     Subroutine utilisee pour calculer des valeurs de sigma modifie

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

    r5099 r5103  
    3838      DO iter = 1,lh
    3939
    40       CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1  )
     40      CALL filtreg ( divgra,jjp1,klevel,2,1,.TRUE.,1  )
    4141
    4242      CALL    grad (klevel,divgra, ghx  , ghy          )
    4343      CALL  diverg (klevel,  ghx , ghy  , divgra       )
    4444
    45       CALL filtreg ( divgra,jjp1,klevel,2,1,.true.,1)
     45      CALL filtreg ( divgra,jjp1,klevel,2,1,.TRUE.,1)
    4646
    4747      DO l = 1,klevel

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

    r5101 r5103  
    5252    REAL unpl2k,dellta
    5353
    54     logical,save :: firstcall=.true.
     54    logical,save :: firstcall=.TRUE.
    5555    character(len=*),parameter :: modname="exner_hyb"
    5656
    … …  
    6969       endif ! of if (llm.eq.1)
    7070
    71        firstcall=.false.
     71       firstcall=.FALSE.
    7272    endif ! of if (firstcall)
    7373

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

    r5101 r5103  
    4949    REAL dum1
    5050
    51     logical,save :: firstcall=.true.
     51    logical,save :: firstcall=.TRUE.
    5252    character(len=*),parameter :: modname="exner_milieu"
    5353
    … …  
    6666       endif ! of if (llm.eq.1)
    6767
    68        firstcall=.false.
     68       firstcall=.FALSE.
    6969    endif ! of if (firstcall)
    7070

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

    r5099 r5103  
    1313      INTEGER i, j, n, ig
    1414c
    15 c       print*,'iim jjm ',iim,jjm
     15c       PRINT*,'iim jjm ',iim,jjm
    1616
    1717c modif par abd 21 02 01

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

    r5099 r5103  
    22! $Header$
    33
    4       subroutine gr_int_dyn(champin,champdyn,iim,jp1)
     4      SUBROUTINE gr_int_dyn(champin,champdyn,iim,jp1)
    55      implicit none
    66c=======================================================================

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

    r5099 r5103  
    4040c
    4141      CALL  diverg( klevel,  gdx , gdy, div          )
    42       CALL filtreg( div, jjp1, klevel, 2,1, .true.,2 )
     42      CALL filtreg( div, jjp1, klevel, 2,1, .TRUE.,2 )
    4343      CALL    grad( klevel,  div, gdx, gdy           )
    4444c

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

    r5099 r5103  
    22! $Header$
    33
    4       integer nfmx,imx,jmx,lmx,nvarmx
    5       parameter(nfmx=10,imx=200,jmx=150,lmx=200,nvarmx=1000)
     4integer nfmx,imx,jmx,lmx,nvarmx
     5parameter(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
    17       character*10 var(nvarmx,nfmx),fichier(nfmx)
    18       character*40 title(nfmx),tvar(nvarmx,nfmx)
     17character*10 var(nvarmx,nfmx),fichier(nfmx)
     18character*40 title(nfmx),tvar(nvarmx,nfmx)
    1919
    20       common/gradsdef/xd,yd,zd,dtime,
    21      s   imd,jmd,lmd,iid,jid,ifd,jfd,
    22      s   unit,irec,nvar,ivar,itime,nld,firsttime,
    23      s   var,fichier,title,tvar
     20common/gradsdef/xd,yd,zd,dtime,
     21imd,jmd,lmd,iid,jid,ifd,jfd,
     22unit,irec,nvar,ivar,itime,nld,firsttime,
     23var,fichier,title,tvar

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

    r5101 r5103  
    22! $Id: $
    33
    4 ! This subroutine creates the grilles_gcm.nc file, containing:
     4! This SUBROUTINE creates the grilles_gcm.nc file, containing:
    55! -> longitudes and latitudes in degrees for dynamical grids u, v and scalaire,
    66! and the following variables added for INCA (informative anyway)
    … …  
    88! -> mask (land/sea), area (grid), phis=surface geopotential height = phis/g
    99
    10 ! The subroutine is called in dynphy_lonlat/phylmd/ce0l.F90.
     10! The SUBROUTINE is called in dynphy_lonlat/phylmd/ce0l.F90.
    1111
    1212SUBROUTINE grilles_gcm_netcdf_sub(masque,phis)

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

    r5101 r5103  
    196196    SELECT CASE(type_trac)
    197197    CASE('inca', 'inco')
    198       IF (CPPKEY_INCA) THEN
     198      IF (.NOT. CPPKEY_INCA) THEN
    199199        CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
    200200      END IF
    … …  
    228228    IF(fType == 1 .AND. ANY(['inca', 'inco']==type_trac)) THEN         !=== FOUND OLD STYLE INCA "traceur.def"
    229229      !---------------------------------------------------------------------------------------------------------------------------
    230       IF (CPPKEY_INCA) THEN
    231230        nqo = SIZE(tracers) - nqCO2
    232231        CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
    … …  
    259258        IF(setGeneration(tracers)) CALL abort_gcm(modname, 'See above', 1) !- SET FIELDS %iGeneration, %gen0Name
    260259        DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
    261       END IF
    262260      !---------------------------------------------------------------------------------------------------------------------------
    263261    ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
    … …  
    268266      nbtr = nqtrue - COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
    269267              .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
    270       IF (CPPKEY_INCA) THEN
    271268        nqINCA = COUNT(tracers(:)%component == 'inca')
    272       END IF
    273269      lerr = getKey('hadv', hadv, ky = tracers(:)%keys)
    274270      lerr = getKey('vadv', vadv, ky = tracers(:)%keys)

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

    r5101 r5103  
    55
    66  USE control_mod
    7 #ifdef CPP_IOIPSL
    87  use IOIPSL
    9 #else
    10   ! if not using IOIPSL, we still need to use (a local version of) getin
    11   use ioipsl_getincom
    12 #endif
    138  USE comconst_mod, ONLY: im, imp1, jm, jmp1, lllm, lllmm1, lllmp1, &
    149                          unsim, pi, r, kappa, cpp, dtvr, dtphys

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

    r5102 r5103  
    1 
    21! $Header$
    32
    4       subroutine inigrads(if,im
    5      s  ,x,fx,xmin,xmax,jm,y,ymin,ymax,fy,lm,z,fz
    6      s  ,dt,file,titlel)
     3SUBROUTINE inigrads(if, im &
     4        , x, fx, xmin, xmax, jm, y, ymin, ymax, fy, lm, z, fz &
     5        , dt, file, titlel)
    76
     7  implicit none
    88
    9       implicit none
     9  integer :: if, im, jm, lm, i, j, l
     10  real :: x(im), y(jm), z(lm), fx, fy, fz, dt
     11  real :: xmin, xmax, ymin, ymax
    1012
    11       integer if,im,jm,lm,i,j,l
    12       real x(im),y(jm),z(lm),fx,fy,fz,dt
    13       real xmin,xmax,ymin,ymax
     13  character(len = *), intent(in) :: file
     14  character(len = *), intent(in) :: titlel
    1415
    15       character(len=*),intent(in) :: file
    16       character(len=*),intent(in) :: titlel
     16  INCLUDE "gradsdef.h"
    1717
    18       INCLUDE "gradsdef.h"
     18  ! data unit/66,32,34,36,38,40,42,44,46,48/
     19  integer :: nf
     20  save nf
     21  data nf/0/
    1922
    20 c     data unit/66,32,34,36,38,40,42,44,46,48/
    21       integer nf
    22       save nf
    23       data nf/0/
     23  unit(1) = 66
     24  unit(2) = 32
     25  unit(3) = 34
     26  unit(4) = 36
     27  unit(5) = 38
     28  unit(6) = 40
     29  unit(7) = 42
     30  unit(8) = 44
     31  unit(9) = 46
    2432
    25       unit(1)=66
    26       unit(2)=32
    27       unit(3)=34
    28       unit(4)=36
    29       unit(5)=38
    30       unit(6)=40
    31       unit(7)=42
    32       unit(8)=44
    33       unit(9)=46
     33  if (if<=nf) stop'verifier les appels a inigrads'
    3434
    35       if (if<=nf) stop'verifier les appels a inigrads'
     35  PRINT*, 'Entree dans inigrads'
    3636
    37       print*,'Entree dans inigrads'
     37  nf = if
     38  title(if) = titlel
     39  ivar(if) = 0
    3840
    39       nf=if
    40       title(if)=titlel
    41       ivar(if)=0
     41  fichier(if) = trim(file)
    4242
    43       fichier(if)=trim(file)
     43  firsttime(if) = .TRUE.
     44  dtime(if) = dt
    4445
    45       firsttime(if)=.true.
    46       dtime(if)=dt
     46  iid(if) = 1
     47  ifd(if) = im
     48  imd(if) = im
     49  do i = 1, im
     50    xd(i, if) = x(i) * fx
     51    if(xd(i, if)<xmin) iid(if) = i + 1
     52    if(xd(i, if)<=xmax) ifd(if) = i
     53  enddo
     54  PRINT*, 'On stoke du point ', iid(if), '  a ', ifd(if), ' en x'
    4755
    48       iid(if)=1
    49       ifd(if)=im
    50       imd(if)=im
    51       do i=1,im
    52          xd(i,if)=x(i)*fx
    53          if(xd(i,if)<xmin) iid(if)=i+1
    54          if(xd(i,if)<=xmax) ifd(if)=i
    55       enddo
    56       print*,'On stoke du point ',iid(if),'  a ',ifd(if),' en x'
     56  jid(if) = 1
     57  jfd(if) = jm
     58  jmd(if) = jm
     59  do j = 1, jm
     60    yd(j, if) = y(j) * fy
     61    if(yd(j, if)>ymax) jid(if) = j + 1
     62    if(yd(j, if)>=ymin) jfd(if) = j
     63  enddo
     64  PRINT*, 'On stoke du point ', jid(if), '  a ', jfd(if), ' en y'
    5765
    58       jid(if)=1
    59       jfd(if)=jm
    60       jmd(if)=jm
    61       do j=1,jm
    62          yd(j,if)=y(j)*fy
    63          if(yd(j,if)>ymax) jid(if)=j+1
    64          if(yd(j,if)>=ymin) jfd(if)=j
    65       enddo
    66       print*,'On stoke du point ',jid(if),'  a ',jfd(if),' en y'
     66  PRINT*, 'Open de dat'
     67  PRINT*, 'file=', file
     68  PRINT*, 'fichier(if)=', fichier(if)
    6769
    68       print*,'Open de dat'
    69       print*,'file=',file
    70       print*,'fichier(if)=',fichier(if)
     70  PRINT*, 4 * (ifd(if) - iid(if)) * (jfd(if) - jid(if))
     71  PRINT*, trim(file) // '.dat'
    7172
    72       print*,4*(ifd(if)-iid(if))*(jfd(if)-jid(if))
    73       print*,trim(file)//'.dat'
     73  OPEN (unit(if) + 1, FILE = trim(file) // '.dat' &
     74          , FORM = 'unformatted', &
     75          ACCESS = 'direct' &
     76          , RECL = 4 * (ifd(if) - iid(if) + 1) * (jfd(if) - jid(if) + 1))
    7477
    75       OPEN (unit(if)+1,FILE=trim(file)//'.dat'
    76      s   ,FORM='unformatted',
    77      s   ACCESS='direct'
    78      s  ,RECL=4*(ifd(if)-iid(if)+1)*(jfd(if)-jid(if)+1))
     78  PRINT*, 'Open de dat ok'
    7979
    80       print*,'Open de dat ok'
     80  lmd(if) = lm
     81  do l = 1, lm
     82    zd(l, if) = z(l) * fz
     83  enddo
    8184
    82       lmd(if)=lm
    83       do l=1,lm
    84          zd(l,if)=z(l)*fz
    85       enddo
     85  irec(if) = 0
    8686
    87       irec(if)=0
     87  PRINT*, if, imd(if), jmd(if), lmd(if)
     88  PRINT*, 'if,imd(if),jmd(if),lmd(if)'
    8889
    89       print*,if,imd(if),jmd(if),lmd(if)
    90       print*,'if,imd(if),jmd(if),lmd(if)'
    91 
    92       return
    93       end
     90  return
     91end subroutine inigrads

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

    r5101 r5103  
    11! $Id$
    22
    3 subroutine initdynav(day0,anne0,tstep,t_ops,t_wrt)
     3SUBROUTINE initdynav(day0,anne0,tstep,t_ops,t_wrt)
    44
    5 #ifdef CPP_IOIPSL
    65  USE IOIPSL
    7 #endif
    86  USE infotrac, ONLY: nqtot
    97  use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid, &
    … …  
    4745  real tstep, t_ops, t_wrt
    4846
    49 #ifdef CPP_IOIPSL
    5047  ! This routine needs IOIPSL to work
    5148  !   Variables locales
    … …  
    8279  ! Creation de 3 fichiers pour les differentes grilles horizontales
    8380  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
    84   ! Grille Scalaire       
     81  ! Grille Scalaire
    8582  CALL histbeg(dynhistave_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
    8683       1, iip1, 1, jjp1, &
    … …  
    185182  CALL histend(histuaveid)
    186183  CALL histend(histvaveid)
    187 #else
    188   write(lunout,*)"initdynav: Warning this routine should not be", &
    189        " used without ioipsl"
    190 #endif
    191   ! of #ifdef CPP_IOIPSL
    192184
    193 end subroutine initdynav
     185END SUBROUTINE initdynav

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

    r5101 r5103  
    22! $Id$
    33
    4       subroutine initfluxsto
     4      SUBROUTINE initfluxsto
    55     .  (infile,tstep,t_ops,t_wrt,
    66     .                    fileid,filevid,filedid)
    77
    8 #ifdef CPP_IOIPSL
    98       USE IOIPSL
    10 #endif
    119      USE comconst_mod, ONLY: pi
    1210      USE comvert_mod, ONLY: nivsigs
    … …  
    5452      integer fileid, filevid,filedid
    5553
    56 #ifdef CPP_IOIPSL
    5754! This routine needs IOIPSL to work
    5855C   Variables locales
    … …  
    7572      str='q  '
    7673      ctrac = 'traceur   '
    77       ok_sync = .true.
     74      ok_sync = .TRUE.
    7875C
    7976C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    80 C         
     77C
    8178
    8279      zan = annee_ref
    … …  
    8481      CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
    8582      tau0 = itau_dyn
    86        
     83
    8784        do jj = 1, jjp1
    8885        do ii = 1, iip1
    … …  
    9188        enddo
    9289      enddo
    93  
     90
    9491      CALL histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
    9592     .             1, iip1, 1, jjp1,
    … …  
    9794C
    9895C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    99 C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans 
     96C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
    10097C  un meme fichier)
    10198
    … …  
    111108     .             1, iip1, 1, jjm,
    112109     .             tau0, zjulian, tstep, vhoriid, filevid)
    113        
     110
    114111        rl(1,1) = 1.
    115112      CALL histbeg('defstoke.nc', 1, rl, 1, rl,
    … …  
    129126      CALL histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
    130127     .              'Grille points scalaires', thoriid)
    131        
     128
    132129C
    133130C  Appel a histvert pour la grille verticale
    … …  
    148145C
    149146C  Appels a histdef pour la definition des variables a sauvegarder
    150        
     147
    151148        CALL histdef(fileid, "phis", "Surface geop. height", "-",
    152149     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
    … …  
    156153     .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
    157154     .                "once", t_ops, t_wrt)
    158        
     155
    159156        CALL histdef(filedid, "dtvr", "tps dyn", "s",
    160157     .                1,1,dhoriid, 1,1,1, -99, 32,
    161158     .                "once", t_ops, t_wrt)
    162        
     159
    163160         CALL histdef(filedid, "istdyn", "tps stock", "s",
    164161     .                1,1,dhoriid, 1,1,1, -99, 32,
    165162     .                "once", t_ops, t_wrt)
    166          
     163
    167164         CALL histdef(filedid, "istphy", "tps stock phy", "s",
    168165     .                1,1,dhoriid, 1,1,1, -99, 32,
    … …  
    171168
    172169C
    173 C Masse 
     170C Masse
    174171C
    175172      CALL histdef(fileid, 'masse', 'Masse', 'kg',
    … …  
    177174     .             32, 'inst(X)', t_ops, t_wrt)
    178175C
    179 C  Pbaru 
     176C  Pbaru
    180177C
    181178      CALL histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
    … …  
    184181
    185182C
    186 C  Pbarv 
     183C  Pbarv
    187184C
    188185      CALL histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
    … …  
    190187     .             32, 'inst(X)', t_ops, t_wrt)
    191188C
    192 C  w 
     189C  w
    193190C
    194191      CALL histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
    … …  
    205202
    206203C
    207 C Geopotentiel 
     204C Geopotentiel
    208205C
    209206      CALL histdef(fileid, 'phi', 'geopotentiel instantane', '-',
    … …  
    221218        CALL histsync(filedid)
    222219      endif
    223        
    224 #else
    225 ! tell the user this routine should be run with ioipsl
    226       write(lunout,*)"initfluxsto: Warning this routine should not be",
    227      &               " used without ioipsl"
    228 #endif
    229 ! of #ifdef CPP_IOIPSL
     220
    230221      return
    231222      end

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

    r5101 r5103  
    11! $Id$
    22
    3 subroutine inithist(day0, anne0, tstep, t_ops, t_wrt)
     3SUBROUTINE inithist(day0, anne0, tstep, t_ops, t_wrt)
    44
    5 #ifdef CPP_IOIPSL
    65   USE IOIPSL
    7 #endif
    86  USE infotrac, ONLY: nqtot
    97  use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
    … …  
    5149  real :: tstep, t_ops, t_wrt
    5250
    53 #ifdef CPP_IOIPSL
    5451  ! This routine needs IOIPSL to work
    5552  !   Variables locales
    … …  
    185182  CALL histend(histuid)
    186183  CALL histend(histvid)
    187 #else
    188   ! tell the user this routine should be run with ioipsl
    189   write(lunout, *)"inithist: Warning this routine should not be", &
    190           " used without ioipsl"
    191 #endif
    192   ! of #ifdef CPP_IOIPSL
    193   return
    194 end subroutine inithist
     184END SUBROUTINE  inithist

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

    r5099 r5103  
    22! $Header$
    33
    4         subroutine interpost(q,qppm)
     4        SUBROUTINE interpost(q,qppm)
    55
    66       implicit none

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

    r5099 r5103  
    22! $Id$
    33
    4        subroutine interpre(q,qppm,w,fluxwppm,masse,
     4       SUBROUTINE interpre(q,qppm,w,fluxwppm,masse,
    55     s            apppm,bpppm,massebx,masseby,pbaru,pbarv,
    66     s            unatppm,vnatppm,psppm)
    … …  
    9292              do i=1,iip1             
    9393               fluxw(i,j,l)=w(i,j,l)*g*0.01/aire(i,j)
    94 C               print*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
     94C               PRINT*,i,j,l,'fluxw(i,j,l)=',fluxw(i,j,l),
    9595C     c                      'w(i,j,l)=',w(i,j,l)
    9696              enddo

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

    r5086 r5103  
    77contains
    88
    9   subroutine invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
     9  SUBROUTINE invert_zoom_x(xf, xtild, Xprimt, xlon, xprimm, xuv)
    1010
    1111    use coefpoly_m, only: coefpoly
    … …  
    8484    xprimm = xxprim
    8585
    86   end subroutine invert_zoom_x
     86  END SUBROUTINE invert_zoom_x
    8787
    8888end module invert_zoom_x_m

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

    r5099 r5103  
    4747      EXTERNAL  SSUM, ismin,ismax
    4848
    49       data first/.true./
     49      data first/.TRUE./
    5050
    5151

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

    r5081 r5103  
    5353      EXTERNAL filtreg
    5454
    55       data first/.true./
     55      data first/.TRUE./
    5656
    5757      if(first) then
    58          print*,'SCHEMA AMONT NOUVEAU'
    59          first=.false.
     58         PRINT*,'SCHEMA AMONT NOUVEAU'
     59         first=.FALSE.
    6060         do i=2,iip1
    6161            coslon(i)=cos(rlonv(i))
    … …  
    114114c   calcul des pentes limites aux poles
    115115
    116 c     print*,dyqv(iip1+1)
     116c     PRINT*,dyqv(iip1+1)
    117117c     appn=abs(dyq(1)/dyqv(iip1+1))
    118 c     print*,dyq(ip1jm+1)
    119 c     print*,dyqv(ip1jm-iip1+1)
     118c     PRINT*,dyq(ip1jm+1)
     119c     PRINT*,dyqv(ip1jm-iip1+1)
    120120c     apps=abs(dyq(ip1jm+1)/dyqv(ip1jm-iip1+1))
    121121c     do ij=2,iim

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

    r5099 r5103  
    4747      EXTERNAL  SSUM, ismin,ismax
    4848
    49       data first/.true./
     49      data first/.TRUE./
    5050
    5151

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

    r5099 r5103  
    3838      DO iter = 1,lr
    3939      CALL  rotat (klevel,grx, gry, rot )
    40       CALL filtreg( rot, jjm, klevel, 2,1, .false.,2)
     40      CALL filtreg( rot, jjm, klevel, 2,1, .FALSE.,2)
    4141      CALL nxgrad (klevel,rot, grx, gry )
    4242c

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

    r5101 r5103  
    6868
    6969c  modif Fred 24 03 96
    70       data first/.true./
     70      data first/.TRUE./
    7171
    7272      limit = .TRUE.
    … …  
    8585      qmin=0.
    8686      if(first) then
    87          print*,'SCHEMA AMONT NOUVEAU'
    88          first=.false.
     87         PRINT*,'SCHEMA AMONT NOUVEAU'
     88         first=.FALSE.
    8989         do i=2,iip1
    9090            coslon(i)=cos(rlonv(i))
    … …  
    9292            coslondlon(i)=coslon(i)*(rlonu(i)-rlonu(i-1))/pi
    9393            sinlondlon(i)=sinlon(i)*(rlonu(i)-rlonu(i-1))/pi
    94             print*,coslondlon(i),sinlondlon(i)
     94            PRINT*,coslondlon(i),sinlondlon(i)
    9595         enddo
    9696         coslon(1)=coslon(iip1)
    … …  
    9898         sinlon(1)=sinlon(iip1)
    9999         sinlondlon(1)=sinlondlon(iip1)
    100          print*,'sum sinlondlon ',ssum(iim,sinlondlon,1)/sinlondlon(1)
    101          print*,'sum coslondlon ',ssum(iim,coslondlon,1)/coslondlon(1)
     100         PRINT*,'sum sinlondlon ',ssum(iim,sinlondlon,1)/sinlondlon(1)
     101         PRINT*,'sum coslondlon ',ssum(iim,coslondlon,1)/coslondlon(1)
    102102        DO l = 1,llm
    103103        DO j = 1,jjp1
    … …  
    182182c             zq=s0(i,j,l)/sm(i,j,l)
    183183c            if(zq.lt.qmin)
    184 c    ,       print*,'avant advx1, s0(',i,',',j,',',l,')=',zq
     184c    ,       PRINT*,'avant advx1, s0(',i,',',j,',',l,')=',zq
    185185c          enddo
    186186c         enddo
    … …  
    324324c             zq=s0(i,j,l)/sm(i,j,l)
    325325c            if(zq.lt.qmin)
    326 c    ,       print*,'apres advx2, s0(',i,',',j,',',l,')=',zq
     326c    ,       PRINT*,'apres advx2, s0(',i,',',j,',',l,')=',zq
    327327c          enddo
    328328c         enddo
    … …  
    460460           do i=1,iip1
    461461             if(q(i,j,l,0)<qmin)
    462      ,       print*,'apres pentes, s0(',i,',',j,',',l,')=',q(i,j,l,0)
     462     ,       PRINT*,'apres pentes, s0(',i,',',j,',',l,')=',q(i,j,l,0)
    463463           enddo
    464464          enddo

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

    r5101 r5103  
    6262C ****6***0*********0*********0*********0*********0*********0**********72
    6363C
    64       subroutine ppm3d(IGD,Q,PS1,PS2,U,V,W,NDT,IORD,JORD,KORD,NC,IMR,
     64      SUBROUTINE ppm3d(IGD,Q,PS1,PS2,U,V,W,NDT,IORD,JORD,KORD,NC,IMR,
    6565     &                  JNP,j1,NLAY,AP,BP,PT,AE,fill,dum,Umax)
    6666
    … …  
    297297     &     cosp(Jmax), cose(Jmax), DAP(kmax),DBK(Kmax)
    298298      data NDT0, NSTEP /0, 0/
    299       data cross /.true./
     299      data cross /.TRUE./
    300300      REAL DTDY, DTDY5, RCAP
    301301      INTEGER JS0, JN0, IML, JMR, IMJM
    … …  
    404404      DTDX(j)  = DT / ( DL*AE*COSP(J) )
    405405
    406 c     print*,'dtdx=',dtdx(j)
     406c     PRINT*,'dtdx=',dtdx(j)
    407407      DTDX5(j) = 0.5*DTDX(j)
    408408      enddo
    … …  
    410410     
    411411      DTDY  = DT /(AE*DP)
    412 c      print*,'dtdy=',dtdy
     412c      PRINT*,'dtdy=',dtdy
    413413      DTDY5 = 0.5*DTDY
    414414C
    … …  
    751751   
    752752      if(fill) CALL qckxyz(DQ(1,1,1,IC),DC2,IMR,JNP,NLAY,j1,j2,
    753      &                     cosp,acosp,.false.,IC,NSTEP)
     753     &                     cosp,acosp,.FALSE.,IC,NSTEP)
    754754C
    755755C Recover tracer mixing ratio from "density" using predicted
    … …  
    760760      DO i=1,IMR
    761761            Q(i,j,k,IC) = DQ(i,j,k,IC) / delp2(i,j,k)
    762 c            print*,'i=',i,'j=',j,'k=',k,'Q(i,j,k,IC)=',Q(i,j,k,IC)
     762c            PRINT*,'i=',i,'j=',j,'k=',k,'Q(i,j,k,IC)=',Q(i,j,k,IC)
    763763      enddo
    764764      enddo
    … …  
    789789C
    790790C****6***0*********0*********0*********0*********0*********0**********72
    791       subroutine FZPPM(IMR,JNP,NLAY,j1,DQ,WZ,P,DC,DQDT,AR,AL,A6,
     791      SUBROUTINE FZPPM(IMR,JNP,NLAY,j1,DQ,WZ,P,DC,DQDT,AR,AL,A6,
    792792     &                 flux,wk1,wk2,wz2,delp,KORD)
    793793      implicit none
    … …  
    964964      end
    965965C
    966       subroutine xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ,Q,UC,
     966      SUBROUTINE xtp(IMR,JNP,IML,j1,j2,JN,JS,PU,DQ,Q,UC,
    967967     &               fx1,xmass,IORD)
    968968      implicit none
    … …  
    10871087      end
    10881088C
    1089       subroutine fxppm(IMR,IML,UT,P,DC,flux,IORD)
     1089      SUBROUTINE fxppm(IMR,IML,UT,P,DC,flux,IORD)
    10901090      implicit none
    10911091      integer IMR,IML,IORD
    … …  
    10961096      integer LMT,IMP,JLVL,i
    10971097c      logical first
    1098 c      data first /.true./
     1098c      data first /.TRUE./
    10991099c      SAVE LMT
    11001100c      if(first) then
    … …  
    11161116      LMT = IORD - 3
    11171117c      write(6,*) 'PPM option in E-W direction = ', LMT
    1118 c      first = .false.
     1118c      first = .FALSE.
    11191119C      endif
    11201120C
    … …  
    11501150      end
    11511151C
    1152       subroutine xmist(IMR,IML,P,DC)
     1152      SUBROUTINE xmist(IMR,IML,P,DC)
    11531153      implicit none
    11541154      integer IMR,IML
    … …  
    11671167      end
    11681168C
    1169       subroutine ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ,P,VC,DC2
     1169      SUBROUTINE ytp(IMR,JNP,j1,j2,acosp,RCAP,DQ,P,VC,DC2
    11701170     &              ,ymass,fx,A6,AR,AL,JORD)
    11711171      implicit none
    … …  
    13201320      end
    13211321C
    1322       subroutine fyppm(VC,P,DC,flux,IMR,JNP,j1,j2,A6,AR,AL,JORD)
     1322      SUBROUTINE fyppm(VC,P,DC,flux,IMR,JNP,j1,j2,A6,AR,AL,JORD)
    13231323      implicit none
    13241324      integer IMR,JNP,j1,j2,JORD
    … …  
    13301330      integer IMH,JMR,j11,IMJM1,len
    13311331c      logical first
    1332 C      data first /.true./
     1332C      data first /.TRUE./
    13331333C      SAVE LMT
    13341334C
    … …  
    13511351C      endif
    13521352C
    1353 C      first = .false.
     1353C      first = .FALSE.
    13541354C      endif
    13551355C     
    … …  
    14001400      end
    14011401C
    1402         subroutine yadv(IMR,JNP,j1,j2,p,VA,ady,wk,IAD)
     1402        SUBROUTINE yadv(IMR,JNP,j1,j2,p,VA,ady,wk,IAD)
    14031403        implicit none
    14041404        integer IMR,JNP,j1,j2,IAD
    … …  
    14901490        end
    14911491C
    1492         subroutine xadv(IMR,JNP,j1,j2,p,UA,JS,JN,IML,adx,IAD)
     1492        SUBROUTINE xadv(IMR,JNP,j1,j2,p,UA,JS,JN,IML,adx,IAD)
    14931493        implicit none
    14941494        INTEGER IMR,JNP,j1,j2,JS,JN,IML,IAD
    … …  
    15831583        end
    15841584C
    1585       subroutine lmtppm(DC,A6,AR,AL,P,IM,LMT)
     1585      SUBROUTINE lmtppm(DC,A6,AR,AL,P,IM,LMT)
    15861586      implicit none
    15871587C
    … …  
    16641664      end
    16651665C
    1666       subroutine A2C(U,V,IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
     1666      SUBROUTINE A2C(U,V,IMR,JMR,j1,j2,CRX,CRY,dtdx5,DTDY5)
    16671667      implicit none
    16681668      integer IMR,JMR,j1,j2
    … …  
    16861686      end
    16871687C
    1688       subroutine cosa(cosp,cose,JNP,PI,DP)
     1688      SUBROUTINE cosa(cosp,cose,JNP,PI,DP)
    16891689      implicit none
    16901690      integer JNP
    … …  
    17191719      end
    17201720C
    1721       subroutine cosc(cosp,cose,JNP,PI,DP)
     1721      SUBROUTINE cosc(cosp,cose,JNP,PI,DP)
    17221722      implicit none
    17231723      integer JNP
    … …  
    18521852      END
    18531853C
    1854       subroutine filcr(q,IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
     1854      SUBROUTINE filcr(q,IMR,JNP,j1,j2,cosp,acosp,icr,tiny)
    18551855      implicit none
    18561856      integer :: IMR,JNP,j1,j2,icr
    … …  
    19551955      end
    19561956C
    1957       subroutine filns(q,IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
     1957      SUBROUTINE filns(q,IMR,JNP,j1,j2,cosp,acosp,ipy,tiny)
    19581958      implicit none
    19591959      integer :: IMR,JNP,j1,j2,ipy
    … …  
    19621962      INTEGER :: i,j
    19631963c      logical first
    1964 c      data first /.true./
     1964c      data first /.TRUE./
    19651965c      save cap1
    19661966C
    … …  
    19681968      DP = 4.*ATAN(1.)/REAL(JNP-1)
    19691969      CAP1 = IMR*(1.-COS((j1-1.5)*DP))/DP
    1970 c      first = .false.
     1970c      first = .FALSE.
    19711971c      endif
    19721972C
    … …  
    20422042      end
    20432043C
    2044       subroutine filew(q,qtmp,IMR,JNP,j1,j2,ipx,tiny)
     2044      SUBROUTINE filew(q,qtmp,IMR,JNP,j1,j2,ipx,tiny)
    20452045      implicit none
    20462046      integer :: IMR,JNP,j1,j2,ipx
    … …  
    21242124      end
    21252125C
    2126       subroutine zflip(q,im,km,nc)
     2126      SUBROUTINE zflip(q,im,km,nc)
    21272127      implicit none
    21282128C This routine flip the array q (in the vertical).

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

    r5101 r5103  
    6767
    6868
    69       data first/.true./
     69      data first/.TRUE./
    7070      data qmin,qmax/-1.e33,1.e33/
    7171
    … …  
    8181 
    8282      if(first) then
    83          print*,'SCHEMA PRATHER'
    84          first=.false.
     83         PRINT*,'SCHEMA PRATHER'
     84         first=.FALSE.
    8585         do i=2,iip1
    8686            coslon(i)=cos(rlonv(i))
    … …  
    251251         enddo
    252252c       enddo
    253 c         print*,'qpn',qpn,'qps',qps
    254 c          print*,'dqzpn',dqzpn,'dqzps',dqzps
     253c         PRINT*,'qpn',qpn,'qps',qps
     254c          PRINT*,'dqzpn',dqzpn,'dqzps',dqzps
    255255c       enddo
    256256           dyn1=0.

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

    r2598 r5103  
    55contains
    66
    7   subroutine principal_cshift(is2, xlon, xprimm)
     7  SUBROUTINE principal_cshift(is2, xlon, xprimm)
    88
    99    ! Add or subtract 2 pi so that xlon is near [-pi, pi], then cshift
    … …  
    3939    xprimm(iim + 1) = xprimm(1)
    4040
    41   end subroutine principal_cshift
     41  END SUBROUTINE principal_cshift
    4242
    4343end module principal_cshift_m

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

    r5099 r5103  
    6363
    6464      REAL       SSUM
    65       LOGICAL,SAVE :: firstcal=.true.
     65      LOGICAL,SAVE :: firstcal=.TRUE.
    6666      CHARACTER(LEN=*),PARAMETER :: modname="sortvarc"
    6767
    … …  
    7171       if (firstcal) then
    7272         if (.not.read_start) then
    73            resetvarc=.true.
     73           resetvarc=.TRUE.
    7474         endif
    7575       endif
    … …  
    188188      endif
    189189
    190       firstcal = .false.
     190      firstcal = .FALSE.
    191191
    192192      WRITE(lunout,3500) itau, rjour, heure, time

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

    r5101 r5103  
    4747          PRINT *,'STOP dans test_period car ---  TETA  ---  n est pas', 
    4848     ,  ' constant aux poles ! '
    49           print*,'teta(',1 ,',',l,')=',teta(1 ,l)
    50           print*,'teta(',ij,',',l,')=',teta(ij,l)
    51           print*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
    52           print*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
     49          PRINT*,'teta(',1 ,',',l,')=',teta(1 ,l)
     50          PRINT*,'teta(',ij,',',l,')=',teta(ij,l)
     51          PRINT*,'teta(',ip1jm+1 ,',',l,')=',teta(ip1jm+1 ,l)
     52          PRINT*,'teta(',ip1jm+ij,',',l,')=',teta(ip1jm+ij,l)
    5353          stop
    5454          endif
    … …  
    103103          PRINT *,'STOP dans test_period car ---  P     ---  n est pas', 
    104104     ,  ' constant aux poles ! '
    105           print*,'p(',1 ,',',l,')=',p(1 ,l)
    106           print*,'p(',ij,',',l,')=',p(ij,l)
    107           print*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
    108           print*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
     105          PRINT*,'p(',1 ,',',l,')=',p(1 ,l)
     106          PRINT*,'p(',ij,',',l,')=',p(ij,l)
     107          PRINT*,'p(',ip1jm+1 ,',',l,')=',p(ip1jm+1 ,l)
     108          PRINT*,'p(',ip1jm+ij,',',l,')=',p(ip1jm+ij,l)
    109109          stop
    110110          endif

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

    r5099 r5103  
    22! $Id$
    33
    4           subroutine traceurpole(q,masse)
     4          SUBROUTINE traceurpole(q,masse)
    55
    66          implicit none

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

    r5101 r5103  
    22! $Id$
    33
    4 subroutine ugeostr(phi,ucov)
     4SUBROUTINE ugeostr(phi,ucov)
    55
    66  ! Calcul du vent covariant geostrophique a partir du champ de
    … …  
    6767  print *, 301
    6868
    69 end subroutine ugeostr
     69END SUBROUTINE ugeostr

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

    r5101 r5103  
    1010     s  ,dtvr*iperiod,string10,'dyn_zon ')
    1111
    12         callinigrads=.false.
     12        callinigrads=.FALSE.
    1313
    1414

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

    r5101 r5103  
    11! $Id$
    22
    3 subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
     3SUBROUTINE writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
    44
    5 #ifdef CPP_IOIPSL
    65  USE ioipsl
    7 #endif
    86  USE infotrac, ONLY: nqtot
    97  use com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
    … …  
    4644  integer time
    4745
    48 #ifdef CPP_IOIPSL
    4946  ! This routine needs IOIPSL to work
    5047  !   Variables locales
    … …  
    5350  INTEGER iq, ii, ll
    5451  real tm(ip1jmp1*llm)
    55   REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) 
     52  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
    5653  logical ok_sync
    5754  integer itau_w
    … …  
    7572  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    7673
    77   !  Vents U 
     74  !  Vents U
    7875
    7976  CALL histwrite(histuaveid, 'u', itau_w, unat,  &
    … …  
    129126  ENDIF
    130127
    131 #else
    132   write(lunout, *) "writedynav: Warning this routine should not be", &
    133        " used without ioipsl"
    134 #endif
    135   ! of #ifdef CPP_IOIPSL
    136 
    137 end subroutine writedynav
     128END SUBROUTINE  writedynav

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

    r5101 r5103  
    22! $Id$
    33
    4       subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
     4      SUBROUTINE writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
    55
    6 #ifdef CPP_IOIPSL
    76      USE ioipsl
    8 #endif
    97      USE infotrac, ONLY: nqtot
    108      use com_io_dyn_mod, ONLY: histid,histvid,histuid
    … …  
    5351
    5452
    55 #ifdef CPP_IOIPSL
    5653! This routine needs IOIPSL to work
    5754C   Variables locales
    … …  
    123120        CALL histsync(histuid)
    124121      endif
    125 #else
    126 ! tell the user this routine should be run with ioipsl
    127       write(lunout,*)"writehist: Warning this routine should not be",
    128      &               " used without ioipsl"
    129 #endif
    130 ! of #ifdef CPP_IOIPSL
    131122      return
    132123      end
Note: See TracChangeset for help on using the changeset viewer.