Changeset 7


Ignore:
Timestamp:
Oct 28, 2010, 9:30:04 AM (14 years ago)
Author:
emillour
Message:

Mise a niveau de la dynamique par rapport a la version 1447 de LMDZ5
Voir les details dans chantiers/commit_v7.log

Location:
trunk
Files:
1 added
24 edited

Legend:

Unmodified
Added
Removed

  • trunk/libf/dyn3d/addfi.F

    r6 r7  
    11!
    2 ! $Header$
     2! $Id: addfi.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44      SUBROUTINE addfi(pdt, leapf, forward,
    … …  
    77
    88      USE infotrac, ONLY : nqtot
     9      USE control_mod, ONLY : planet_type
    910      IMPLICIT NONE
    1011c
    … …  
    116117      ENDDO
    117118 
    118       DO iq = 1, nqtot
    119        IF ((planet_type.eq.'earth').and.(iq.le.2)) THEN
     119      if (planet_type=="earth") then
     120      ! earth case, special treatment for first 2 tracers (water)
     121       DO iq = 1, 2
    120122         DO k = 1,llm
    121123            DO j = 1,ip1jmp1
    … …  
    124126            ENDDO
    125127         ENDDO
    126        ELSE
     128       ENDDO
     129
     130       DO iq = 3, nqtot
    127131         DO k = 1,llm
    128132            DO j = 1,ip1jmp1
    … …  
    131135            ENDDO
    132136         ENDDO
    133       ENDDO
     137       ENDDO
     138      else
     139      ! general case, treat all tracers equally)
     140       DO iq = 1, nqtot
     141         DO k = 1,llm
     142            DO j = 1,ip1jmp1
     143               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     144               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     145            ENDDO
     146         ENDDO
     147       ENDDO
     148      endif ! of if (planet_type=="earth")
    134149
    135150      DO  ij   = 1, iim

  • trunk/libf/dyn3d/advtrac.F

    r1 r7  
    11!
    2 ! $Id: advtrac.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: advtrac.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    236236            call vlsplt(q(1,1,iq),2.,massem,wg,pbarug,pbarvg,dtvr)
    237237
    238 
    239238c   ----------------------------------------------------------------
    240239c   Schema "pseudo amont" + test sur humidite specifique

  • trunk/libf/dyn3d/caladvtrac.F

    r6 r7  
    11!
    2 ! $Id: caladvtrac.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: caladvtrac.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    99c
    1010      USE infotrac
    11       USE control_mod
     11      USE control_mod, ONLY : iapp_tracvl,planet_type
    1212 
    1313      IMPLICIT NONE
    … …  
    3030c   ----------
    3131      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
    32       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 )
     32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot)
     33      real :: dq(ip1jmp1,llm,nqtot)
    3334      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    3435      REAL               :: flxw(ip1jmp1,llm)
    … …  
    4950cc
    5051c
     52! Earth-specific stuff for the first 2 tracers (water)
     53      if (planet_type.eq."earth") then
    5154C initialisation
    52         dq = 0.
    53 
    54       IF (planet_type.eq."earth") THEN
    55 ! Earth-specific treatment of first 2 tracers (water)
    56 
    57         CALL SCOPY( 2 * ijp1llm, q, 1, dq, 1 )
    58 
     55        dq(:,:,1:2)=q(:,:,1:2)
     56       
    5957c  test des valeurs minmax
    6058cc        CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur (a) ')
    6159cc        CALL minmaxq(q(1,1,2),1.e33,-1.e33,'Eau liquide(a) ')
    62 
     60      endif ! of if (planet_type.eq."earth")
    6361c   advection
    6462
    … …  
    6664     *       p,  masse,q,iapptrac, teta,
    6765     .       flxw, pk)
     66
    6867c
    6968
    70          IF( iapptrac.EQ.iapp_tracvl ) THEN
     69      IF( iapptrac.EQ.iapp_tracvl ) THEN
     70        if (planet_type.eq."earth") then
     71! Earth-specific treatment for the first 2 tracers (water)
    7172c
    7273cc          CALL minmaxq(q(1,1,1),1.e33,-1.e33,'Eau vapeur     ')
    … …  
    100101           ENDDO
    101102c
    102          ELSE 
    103            DO iq = 1 , 2
    104            DO l  = 1, llm
    105              DO ij = 1,ip1jmp1
    106               dq(ij,l,iq)  = 0.
    107              ENDDO
    108            ENDDO
    109            ENDDO
     103        endif ! of if (planet_type.eq."earth")
     104      ELSE
     105        if (planet_type.eq."earth") then
     106! Earth-specific treatment for the first 2 tracers (water)
     107          dq(:,:,1:2)=0.
     108        endif ! of if (planet_type.eq."earth")
     109      ENDIF ! of IF( iapptrac.EQ.iapp_tracvl )
    110110
    111 
    112          ENDIF ! iapptrac VS iapp_tracvl
    113 
    114       ELSE ! not Earth
    115 
    116 c   advection
    117 
    118         CALL advtrac( pbaru,pbarv,
    119      *       p,  masse,q,iapptrac, teta,
    120      .       flxw, pk)
    121 c
    122 
    123       ENDIF ! planet_type
    124 
    125 c
    126 
    127 c  ... On appelle  qminimum uniquement  pour l'eau vapeur et liquide  ..
    128 
    129  
    130       RETURN
    131111      END
    132112

  • trunk/libf/dyn3d/ener.h

    r1 r7  
    11!
    2 ! $Header$
     2! $Id: ener.h 1447 2010-10-22 16:18:27Z jghattas $
    33!
    4 c-----------------------------------------------------------------------
    5 c INCLUDE 'ener.h'
     4!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
     5!                 veillez à n'utiliser que des ! pour les commentaires
     6!                 et à bien positionner les & des lignes de continuation
     7!                 (les placer en colonne 6 et en colonne 73)
     8!
     9! INCLUDE 'ener.h'
    610
    7       COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,
    8      *            ang,etot,ptot,ztot,stot,rmsdpdt ,
    9      *            rmsv,gtot(llmm1)
     11      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
     12     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
     13     &            rmsv,gtot(llmm1)
    1014
    11       REAL ang0,etot0,ptot0,ztot0,stot0,
    12      s     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
     15      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
     16     &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
    1317
    14 c-----------------------------------------------------------------------
     18!-----------------------------------------------------------------------

  • trunk/libf/dyn3d/gcm.F

    r6 r7  
    11!
    2 ! $Id: gcm.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: gcm.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    182182! dynamique -> physique pour l'initialisation
    183183! Ehouarn : temporarily (?) keep this only for Earth
    184       if (planet_type.eq."earth") then
    185 #ifdef CPP_EARTH
     184!      if (planet_type.eq."earth") then
     185!#ifdef CPP_EARTH
     186#ifdef CPP_PHYS
    186187      CALL Init_Phys_lmdz(iim,jjp1,llm,1,(/(jjm-1)*iim+2/))
    187188      call InitComgeomphy
    188189#endif
    189       endif
     190!      endif
    190191!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    191192c
    … …  
    439440! SANS physique, car iniphysiq.F est dans le repertoire phy[]...
    440441! Il faut une cle CPP_PHYS
    441 ! #ifdef CPP_PHYS
     442#ifdef CPP_PHYS
    442443         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    443444     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    444 ! #endif ! CPP_PHYS
     445#endif ! CPP_PHYS
    445446         call_iniphys=.false.
    446447      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))

  • trunk/libf/dyn3d/grid_noro.F

    r1 r7  
    11!
    2 ! $Id: grid_noro.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: grid_noro.F 1442 2010-10-18 08:31:31Z jghattas $
    33!
    44c
    … …  
    458458C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
    459459
    460       PARAMETER (ISMo=400,JSMo=200)
    461       REAL X(IMAR,JMAR),XF(ISMo,JSMo)
     460      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
    462461      real WEIGHTpb(-1:1,-1:1)
    463462
    464       if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
    465       if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'
    466      
     463
    467464      SUM=0.
    468465      DO IS=-1,1

  • trunk/libf/dyn3d/infotrac.F90

    r6 r7  
    3131
    3232  SUBROUTINE infotrac_init
    33 
    3433    USE control_mod
    35  
    3634    IMPLICIT NONE
    3735!=======================================================================
    … …  
    6361    CHARACTER(len=1), DIMENSION(3)  :: txts
    6462    CHARACTER(len=2), DIMENSION(9)  :: txtp
    65     CHARACTER(len=13)               :: str1,str2
     63    CHARACTER(len=23)               :: str1,str2
    6664 
    6765    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    6866    INTEGER :: iq, new_iq, iiq, jq, ierr
    69     INTEGER, EXTERNAL :: lnblnk
    7067 
     68    character(len=*),parameter :: modname="infotrac_init"
    7169!-----------------------------------------------------------------------
    7270! Initialization :
    … …  
    113111          nqtrue=4 ! Defaut value
    114112       END IF
     113       ! For Earth, water vapour & liquid tracers are not in the physics
    115114       nbtr=nqtrue-2
    116115     ELSE
    … …  
    120119
    121120     IF (nqtrue < 2) THEN
    122        WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
     121       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
    123122       CALL abort_gcm('infotrac_init','Not enough tracers',1)
    124123     END IF
    … …  
    134133          nqtrue=1 ! Defaut value
    135134       END IF
     135       ! Other planets (for now); we have the same number of tracers
     136       ! in the dynamics than in the physics
    136137       nbtr=nqtrue
    137138     
    … …  
    179180          END DO
    180181          CLOSE(90) 
    181        ELSE ! Without tracer.def
     182       ELSE ! Without tracer.def, set default values (for Earth!)
     183         if ((nqtrue==4).and.(planet_type=="earth")) then
    182184          hadv(1) = 14
    183185          vadv(1) = 14
    … …  
    192194          vadv(4) = 10
    193195          tnom_0(4) = 'PB'
     196         else
     197           ! Error message, we need a traceur.def file
     198           write(lunout,*) trim(modname),&
     199           ': Cannot set default tracer names!'
     200           write(lunout,*) trim(modname),' Make a traceur.def file!!!'
     201           CALL abort_gcm('infotrac_init','Need a traceur.def file!',1)
     202         endif ! of if (nqtrue==4)
    194203       END IF
    195204       
    196        WRITE(lunout,*) 'Valeur de traceur.def :'
    197        WRITE(lunout,*) 'nombre de traceurs ',nqtrue
     205       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
     206       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
    198207       DO iq=1,nqtrue
    199208          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
    … …  
    234243       END IF
    235244       
    236        WRITE(lunout,*) 'Valeur de traceur.def :'
    237        WRITE(lunout,*) 'nombre de traceurs ',nqtrue
     245       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
     246       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
    238247       DO iq=1,nqtrue
    239248          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
    … …  
    258267          new_iq=new_iq+10 ! 9 tracers added
    259268       ELSE
    260           WRITE(lunout,*) 'This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     269          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    261270          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
    262271       END IF
    … …  
    268277       nqtot = new_iq
    269278
    270        WRITE(lunout,*) 'The choice of advection schema for one or more tracers'
     279       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
    271280       WRITE(lunout,*) 'makes it necessary to add tracers'
    272        WRITE(lunout,*) nqtrue,' is the number of true tracers'
    273        WRITE(lunout,*) nqtot, ' is the total number of tracers needed'
     281       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
     282       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
    274283
    275284    ELSE
    … …  
    299308          iadv(new_iq)=11
    300309       ELSE
    301           WRITE(lunout,*)'This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     310          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     311
    302312          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
    303313       END IF
    … …  
    317327             new_iq=new_iq+1
    318328             iadv(new_iq)=-20
    319              ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq)
    320              tname(new_iq)=str1(1:lnblnk(str1))//txts(jq)
     329             ttext(new_iq)=trim(str2)//txts(jq)
     330             tname(new_iq)=trim(str1)//txts(jq)
    321331          END DO
    322332       ELSE IF (iadv(new_iq)==30) THEN
    … …  
    324334             new_iq=new_iq+1
    325335             iadv(new_iq)=-30
    326              ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq)
    327              tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq)
     336             ttext(new_iq)=trim(str2)//txtp(jq)
     337             tname(new_iq)=trim(str1)//txtp(jq)
    328338          END DO
    329339       END IF
    … …  
    344354
    345355
    346     WRITE(lunout,*) 'Information stored in infotrac :'
    347     WRITE(lunout,*) 'iadv  niadv tname  ttext :'
     356    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
     357    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
    348358    DO iq=1,nqtot
    349        WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq)
     359       WRITE(lunout,*) iadv(iq),niadv(iq),&
     360       ' ',trim(tname(iq)),' ',trim(ttext(iq))
    350361    END DO
    351362
    … …  
    356367    DO iq=1,nqtot
    357368       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
    358           WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     369          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    359370          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
    360371       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
    361           WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     372          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    362373          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    363374       END IF

  • trunk/libf/dyn3d/iniacademic.F

    r1 r7  
    11!
    2 ! $Id: iniacademic.F 1437 2010-09-30 08:29:10Z emillour $
     2! $Id: iniacademic.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    88      USE filtreg_mod
    99      USE infotrac, ONLY : nqtot
    10       USE control_mod
     10      USE control_mod, ONLY: day_step,planet_type
    1111#ifdef CPP_IOIPSL
    1212      USE IOIPSL
    … …  
    9595! 1. Initializations for Earth-like case
    9696! --------------------------------------
    97       if (planet_type=="earth") then
    9897c
    9998        ! initialize planet radius, rotation rate,...
    … …  
    128127          if (.not.read_start) then
    129128            phis(:)=0.
    130             q(:,:,1)=1.e-10
    131             q(:,:,2)=1.e-15
    132             q(:,:,3:nqtot)=0.
     129            q(:,:,:)=0
    133130            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
    134131          endif
    … …  
    138135          ! initializations for the academic case
    139136         
     137!         if (planet_type=="earth") then
     138
    140139          ! 1. local parameters
    141140          ! by convention, winter is in the southern hemisphere
    … …  
    219218          enddo
    220219
     220
     221!         else
     222!          write(lunout,*)"iniacademic: planet types other than earth",
     223!     &                   " not implemented (yet)."
     224!          stop
     225!         endif ! of if (planet_type=="earth")
     226
    221227          ! 3. Initialize fields (if necessary)
    222228          IF (.NOT. read_start) THEN
    … …  
    245251           
    246252            ! bulk initialization of tracers
    247             do i=1,nqtot
    248               if (i.eq.1) q(:,:,i)=1.e-10
    249               if (i.eq.2) q(:,:,i)=1.e-15
    250               if (i.gt.2) q(:,:,i)=0.
    251             enddo
     253            if (planet_type=="earth") then
     254              ! Earth: first two tracers will be water
     255              do i=1,nqtot
     256                if (i.eq.1) q(:,:,i)=1.e-10
     257                if (i.eq.2) q(:,:,i)=1.e-15
     258                if (i.gt.2) q(:,:,i)=0.
     259              enddo
     260            else
     261              q(:,:,:)=0
     262            endif ! of if (planet_type=="earth")
    252263
    253264            ! add random perturbation to temperature
    … …  
    261272            enddo
    262273
     274            ! maintain periodicity in longitude
    263275            do l=1,llm
    264276              do ij=1,ip1jmp1,iip1
    … …  
    267279            enddo
    268280
    269 c     PRINT *,' Appel test_period avec tetarappel '
    270 c     CALL  test_period ( ucov,vcov,tetarappel,q,p,phis )
    271 c     PRINT *,' Appel test_period avec teta '
    272 c     CALL  test_period ( ucov,vcov,teta,q,p,phis )
    273 
    274            ! initialize a traceur on one column
    275 !          j=jjp1*3/4
    276 !          i=iip1/2
    277 !          ij=(j-1)*iip1+i
    278 !          q(ij,:,3)=1.
    279 
    280281          ENDIF ! of IF (.NOT. read_start)
    281282        endif ! of if (iflag_phys.eq.2)
    282283       
    283       else
    284         write(lunout,*)"iniacademic: planet types other than earth",
    285      &                 " not implemented (yet)."
    286         stop
    287       endif ! of if (planet_type=="earth")
    288       return
    289284      END
    290285c-----------------------------------------------------------------------

  • trunk/libf/dyn3d/integrd.F

    r1 r7  
    11!
    2 ! $Id: integrd.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: integrd.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44      SUBROUTINE integrd
    … …  
    66     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps,masse,phis,finvmaold )
    77
    8       USE control_mod
     8      use control_mod, only : planet_type
    99
    1010      IMPLICIT NONE
    … …  
    8181      CALL SCOPY(ip1jmp1*llm, masse, 1, massescr, 1)
    8282
    83       DO 2 ij = 1,ip1jmp1
     83      DO ij = 1,ip1jmp1
    8484       pscr (ij)    = ps(ij)
    8585       ps (ij)      = psm1(ij) + dt * dp(ij)
    86    2  CONTINUE
     86      ENDDO
    8787c
    8888      DO ij = 1,ip1jmp1
    … …  
    115115c    ............   integration  de  ucov, vcov,  h     ..............
    116116
    117       DO 10 l = 1,llm
    118 
    119       DO 4 ij = iip2,ip1jm
    120       uscr( ij )   =  ucov( ij,l )
    121       ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
    122    4  CONTINUE
    123 
    124       DO 5 ij = 1,ip1jm
    125       vscr( ij )   =  vcov( ij,l )
    126       vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
    127    5  CONTINUE
    128 
    129       DO 6 ij = 1,ip1jmp1
    130       hscr( ij )    =  teta(ij,l)
    131       teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l)
    132      $                + dt * dteta(ij,l) / masse(ij,l)
    133    6  CONTINUE
     117      DO l = 1,llm
     118
     119       DO ij = iip2,ip1jm
     120        uscr( ij )   =  ucov( ij,l )
     121        ucov( ij,l ) = ucovm1( ij,l ) + dt * du( ij,l )
     122       ENDDO
     123
     124       DO ij = 1,ip1jm
     125        vscr( ij )   =  vcov( ij,l )
     126        vcov( ij,l ) = vcovm1( ij,l ) + dt * dv( ij,l )
     127       ENDDO
     128
     129       DO ij = 1,ip1jmp1
     130        hscr( ij )    =  teta(ij,l)
     131        teta ( ij,l ) = tetam1(ij,l) *  massem1(ij,l) / masse(ij,l)
     132     &                + dt * dteta(ij,l) / masse(ij,l)
     133       ENDDO
    134134
    135135c   ....  Calcul de la valeur moyenne, unique  aux poles pour  teta    ......
    136136c
    137137c
    138       DO  ij   = 1, iim
     138       DO  ij   = 1, iim
    139139        tppn(ij) = aire(   ij   ) * teta(  ij    ,l)
    140140        tpps(ij) = aire(ij+ip1jm) * teta(ij+ip1jm,l)
    141       ENDDO
     141       ENDDO
    142142        tpn      = SSUM(iim,tppn,1)/apoln
    143143        tps      = SSUM(iim,tpps,1)/apols
    144144
    145       DO ij   = 1, iip1
     145       DO ij   = 1, iip1
    146146        teta(   ij   ,l)  = tpn
    147147        teta(ij+ip1jm,l)  = tps
    148       ENDDO
    149 c
    150 
    151       IF(leapf)  THEN
     148       ENDDO
     149c
     150
     151       IF(leapf)  THEN
    152152         CALL SCOPY ( ip1jmp1, uscr(1), 1, ucovm1(1, l), 1 )
    153153         CALL SCOPY (   ip1jm, vscr(1), 1, vcovm1(1, l), 1 )
    154154         CALL SCOPY ( ip1jmp1, hscr(1), 1, tetam1(1, l), 1 )
    155       END IF
    156 
    157   10  CONTINUE
     155       END IF
     156
     157      ENDDO ! of DO l = 1,llm
    158158
    159159
    … …  
    185185c$$$      ENDIF
    186186
    187         if (planet_type.eq."earth") then
     187      if (planet_type.eq."earth") then
    188188! Earth-specific treatment of first 2 tracers (water)
    189           DO l = 1, llm
    190            DO ij = 1, ip1jmp1
     189        DO l = 1, llm
     190          DO ij = 1, ip1jmp1
    191191            deltap(ij,l) =  p(ij,l) - p(ij,l+1)
    192            ENDDO
    193192          ENDDO
    194 
    195           CALL qminimum( q, nq, deltap )
    196          endif ! of if (planet_type.eq."earth")
     193        ENDDO
     194
     195        CALL qminimum( q, nq, deltap )
    197196
    198197c
    … …  
    200199c
    201200
    202       DO iq = 1, nq
     201       DO iq = 1, nq
    203202        DO l = 1, llm
    204203
    … …  
    216215
    217216        ENDDO
    218       ENDDO
    219 
    220 
    221          CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
     217       ENDDO
     218
     219
     220      CALL  SCOPY( ijp1llm , finvmasse, 1, finvmaold, 1 )
     221
     222      endif ! of if (planet_type.eq."earth")
    222223c
    223224c
    224225c     .....   FIN  de l'integration  de   q    .......
    225 
    226 15    continue
    227226
    228227c    .................................................................

  • trunk/libf/dyn3d/leapfrog.F

    r6 r7  
    11!
    2 ! $Id: leapfrog.F 1437 2010-09-30 08:29:10Z emillour $
     2! $Id: leapfrog.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    225225c   --------------------------------------------------
    226226
    227       dq=0.
     227      dq(:,:,:)=0.
    228228      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    229229      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    … …  
    269269      CALL SCOPY   ( ijp1llm,   masse, 1, finvmaold,     1 )
    270270      CALL filtreg ( finvmaold ,jjp1, llm, -2,2, .TRUE., 1 )
    271 
    272 ! Ehouarn: what is this for? zqmin & zqmax are not used anyway ...
    273 !      call minmax(ijp1llm,q(:,:,3),zqmin,zqmax)
    274271
    275272   2  CONTINUE
    … …  
    470467        ! Sponge layer (if any)
    471468        IF (ok_strato) THEN
     469          dutop(:,:)=0.
     470          dvtop(:,:)=0.
     471          dtetatop(:,:)=0.
     472          dqtop(:,:,:)=0.
     473          dptop(:)=0.
    472474          CALL top_bound(vcov,ucov,teta,masse,dutop,dvtop,dtetatop)
    473475          CALL addfi( dtvr, leapf, forward   ,

  • trunk/libf/dyn3d/limit_netcdf.F90

    r1 r7  
    11!
    2 ! $Id: limit_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
     2! $Id: limit_netcdf.F90 1441 2010-10-13 13:06:56Z emillour $
    33!-------------------------------------------------------------------------------
    44!
    … …  
    9797  kappa = 0.2857143
    9898  cpp   = 1004.70885
    99   dtvr  = daysec/FLOAT(day_step)
     99  dtvr  = daysec/REAL(day_step)
    100100  CALL inigeom
    101101
    … …  
    265265
    266266  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
    267 #endif
    268 ! of #ifdef CPP_EARTH
    269267
    270268
    … …  
    592590
    593591!--- Mid-months times
    594   mid_months(1)=0.5*FLOAT(mnth(1))
     592  mid_months(1)=0.5*REAL(mnth(1))
    595593  DO k=2,nm
    596     mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k))
     594    mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
    597595  END DO
    598596
    … …  
    626624!-------------------------------------------------------------------------------
    627625
     626#endif
     627! of #ifdef CPP_EARTH
    628628
    629629END SUBROUTINE limit_netcdf

  • trunk/libf/dyn3dpar/addfi_p.F

    r1 r7  
    11!
    2 ! $Header$
     2! $Id: addfi_p.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44      SUBROUTINE addfi_p(pdt, leapf, forward,
    … …  
    77      USE parallel
    88      USE infotrac, ONLY : nqtot
     9      USE control_mod, ONLY : planet_type
    910      IMPLICIT NONE
    1011c
    … …  
    154155c$OMP END MASTER
    155156 
    156       DO iq = 1, 2
     157      if (planet_type=="earth") then
     158      ! earth case, special treatment for first 2 tracers (water)
     159       DO iq = 1, 2
    157160c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    158161         DO k = 1,llm
    … …  
    163166         ENDDO
    164167c$OMP END DO NOWAIT
    165       ENDDO
    166 
    167       DO iq = 3, nqtot
     168       ENDDO
     169
     170       DO iq = 3, nqtot
    168171c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    169172         DO k = 1,llm
    … …  
    174177         ENDDO
    175178c$OMP END DO NOWAIT
    176       ENDDO
     179       ENDDO
     180      else
     181      ! general case, treat all tracers equally)
     182       DO iq = 1, nqtot
     183c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     184         DO k = 1,llm
     185            DO j = ijb,ije
     186               pq(j,k,iq)= pq(j,k,iq) + pdqfi(j,k,iq) * pdt
     187               pq(j,k,iq)= AMAX1( pq(j,k,iq), qtestt )
     188            ENDDO
     189         ENDDO
     190c$OMP END DO NOWAIT
     191       ENDDO
     192      endif ! of if (planet_type=="earth")
    177193
    178194c$OMP MASTER

  • trunk/libf/dyn3dpar/advtrac_p.F

    r1 r7  
    11!
    2 ! $Id: advtrac_p.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: advtrac_p.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    132132ccc         CALL filtreg ( massem ,jjp1, llm,-2, 2, .TRUE., 1 )
    133133c
    134       ENDIF
     134      ENDIF ! of IF(iadvtr.EQ.0)
    135135
    136136      iadvtr   = iadvtr+1
    … …  
    266266cym      ----> Revérifier lors de la parallélisation des autres schemas
    267267   
    268 cym          call massbar_p(massem,massebx,masseby)         
     268cym          call massbar_p(massem,massebx,masseby) 
    269269
    270270          call vlspltgen_p( q,iadv, 2., massem, wg ,
    … …  
    452452c$OMP BARRIER
    453453
    454       ijb=ij_begin
    455       ije=ij_end
     454      if (planet_type=="earth") then
     455
     456        ijb=ij_begin
     457        ije=ij_end
    456458
    457459c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)     
    458        DO l = 1, llm
     460        DO l = 1, llm
    459461         DO ij = ijb, ije
    460462           finmasse(ij,l) =  p(ij,l) - p(ij,l+1)
    461463         ENDDO
    462        ENDDO
     464        ENDDO
    463465c$OMP END DO
    464466
    465        CALL qminimum_p( q, 2, finmasse )
     467        CALL qminimum_p( q, 2, finmasse )
    466468
    467469c------------------------------------------------------------------
    … …  
    496498c$OMP BARRIER   
    497499          iadvtr=0
     500      endif ! of if (planet_type=="earth")
    498501       ENDIF ! if iadvtr.EQ.iapp_tracvl
    499502

  • trunk/libf/dyn3dpar/caladvtrac_p.F

    r1 r7  
    11!
    2 ! $Id: caladvtrac_p.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: caladvtrac_p.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    88     *                   flxw, pk, iapptrac)
    99      USE parallel
    10       USE infotrac
    11       USE control_mod
     10      USE infotrac, ONLY : nqtot
     11      USE control_mod, ONLY : iapp_tracvl,planet_type
    1212c
    1313      IMPLICIT NONE
    … …  
    3030c   ----------
    3131      REAL pbaru( ip1jmp1,llm ),pbarv( ip1jm,llm),masse(ip1jmp1,llm)
    32       REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot),dq( ip1jmp1,llm,2 )
     32      REAL p( ip1jmp1,llmp1),q( ip1jmp1,llm,nqtot)
     33      real :: dq( ip1jmp1,llm,nqtot)
    3334      REAL teta( ip1jmp1,llm),pk( ip1jmp1,llm)
    3435      REAL               :: flxw(ip1jmp1,llm)

  • trunk/libf/dyn3dpar/conf_gcm.F

    r1 r7  
    11!
    2 ! $Id: conf_gcm.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: conf_gcm.F 1438 2010-10-08 10:19:34Z jghattas $
    33!
    44c
    … …  
    578578       offline = .FALSE.
    579579       CALL getin('offline',offline)
    580 
     580       IF (offline .AND. adjust) THEN
     581          WRITE(lunout,*)
     582     &         'WARNING : option offline does not work with adjust=y :'
     583          WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ',
     584     &         'and fluxstokev.nc will not be created'
     585          WRITE(lunout,*)
     586     &         'only the file phystoke.nc will still be created '
     587       END IF
     588       
    581589!Config  Key  = config_inca
    582590!Config  Desc = Choix de configuration de INCA
    … …  
    768776       offline = .FALSE.
    769777       CALL getin('offline',offline)
     778       IF (offline .AND. adjust) THEN
     779          WRITE(lunout,*)
     780     &         'WARNING : option offline does not work with adjust=y :'
     781          WRITE(lunout,*) 'the files defstoke.nc, fluxstoke.nc ',
     782     &         'and fluxstokev.nc will not be created'
     783          WRITE(lunout,*)
     784     &         'only the file phystoke.nc will still be created '
     785       END IF
    770786
    771787!Config  Key  = config_inca

  • trunk/libf/dyn3dpar/ener.h

    r1 r7  
    11!
    2 ! $Header$
     2! $Id: ener.h 1447 2010-10-22 16:18:27Z jghattas $
    33!
    4 c-----------------------------------------------------------------------
    5 c INCLUDE 'ener.h'
     4!  ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
     5!                 veillez à n'utiliser que des ! pour les commentaires
     6!                 et à bien positionner les & des lignes de continuation
     7!                 (les placer en colonne 6 et en colonne 73)
     8!
     9! INCLUDE 'ener.h'
    610
    7       COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,
    8      *            ang,etot,ptot,ztot,stot,rmsdpdt ,
    9      *            rmsv,gtot(llmm1)
     11      COMMON/ener/ang0,etot0,ptot0,ztot0,stot0,                         &
     12     &            ang,etot,ptot,ztot,stot,rmsdpdt ,                     &
     13     &            rmsv,gtot(llmm1)
    1014
    11       REAL ang0,etot0,ptot0,ztot0,stot0,
    12      s     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
     15      REAL ang0,etot0,ptot0,ztot0,stot0,                                &
     16     &     ang,etot,ptot,ztot,stot,rmsdpdt,rmsv,gtot
    1317
    14 c-----------------------------------------------------------------------
     18!-----------------------------------------------------------------------

  • trunk/libf/dyn3dpar/gcm.F

    r1 r7  
    11!
    2 ! $Id: gcm.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: gcm.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    276276        endif
    277277
    278         if (planet_type.eq."earth") then
    279 #ifdef CPP_EARTH
     278!        if (planet_type.eq."earth") then
    280279! Load an Earth-format start file
    281280         CALL dynetat0("start.nc",vcov,ucov,
    282281     &              teta,q,masse,ps,phis, time_0)
    283 #else
    284         ! SW model also has Earth-format start files
    285         ! (but can be used without the CPP_EARTH directive)
    286           if (iflag_phys.eq.0) then
    287             CALL dynetat0("start.nc",vcov,ucov,
    288      &              teta,q,masse,ps,phis, time_0)
    289           endif
    290 #endif
    291         endif ! of if (planet_type.eq."earth")
     282!        endif ! of if (planet_type.eq."earth")
     283
    292284c       write(73,*) 'ucov',ucov
    293285c       write(74,*) 'vcov',vcov
    … …  
    494486#endif
    495487
    496       if (planet_type.eq."earth") then
     488!      if (planet_type.eq."earth") then
     489! Write an Earth-format restart file
    497490        CALL dynredem0_p("restart.nc", day_end, phis)
    498       endif
     491!      endif
    499492
    500493      ecripar = .TRUE.

  • trunk/libf/dyn3dpar/grid_noro.F

    r1 r7  
    11!
    2 ! $Id: grid_noro.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: grid_noro.F 1442 2010-10-18 08:31:31Z jghattas $
    33!
    44c
    … …  
    458458C MAKE A MOVING AVERAGE OVER 9 GRIDPOINTS OF THE X FIELDS
    459459
    460       PARAMETER (ISMo=300,JSMo=200)
    461       REAL X(IMAR,JMAR),XF(ISMo,JSMo)
     460      REAL X(IMAR,JMAR),XF(IMAR,JMAR)
    462461      real WEIGHTpb(-1:1,-1:1)
    463462
    464       if(imar.gt.ismo) stop'surdimensionner ismo dans mva9 (grid_noro)'
    465       if(jmar.gt.jsmo) stop'surdimensionner jsmo dans mva9 (grid_noro)'
    466463     
    467464      SUM=0.

  • trunk/libf/dyn3dpar/infotrac.F90

    r1 r7  
    6161    CHARACTER(len=1), DIMENSION(3)  :: txts
    6262    CHARACTER(len=2), DIMENSION(9)  :: txtp
    63     CHARACTER(len=13)               :: str1,str2
     63    CHARACTER(len=23)               :: str1,str2
    6464 
    6565    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    6666    INTEGER :: iq, new_iq, iiq, jq, ierr
    67     INTEGER, EXTERNAL :: lnblnk
    68  
     67
     68    character(len=*),parameter :: modname="infotrac_init"
    6969!-----------------------------------------------------------------------
    7070! Initialization :
    … …  
    100100       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    101101       IF(ierr.EQ.0) THEN
    102           WRITE(lunout,*) 'Open traceur.def : ok'
     102          WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
    103103          READ(90,*) nqtrue
    104104       ELSE
    105           WRITE(lunout,*) 'Problem in opening traceur.def'
    106           WRITE(lunout,*) 'ATTENTION using defaut values'
     105          WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
     106          WRITE(lunout,*) trim(modname),': WARNING using defaut values'
    107107          nqtrue=4 ! Defaut value
    108108       END IF
    109        ! Attention! Only for planet_type=='earth'
    110        nbtr=nqtrue-2
     109       if ( planet_type=='earth') then
     110         ! For Earth, water vapour & liquid tracers are not in the physics
     111         nbtr=nqtrue-2
     112       else
     113         ! Other planets (for now); we have the same number of tracers
     114         ! in the dynamics than in the physics
     115         nbtr=nqtrue
     116       endif
    111117    ELSE
    112118       ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F
    … …  
    114120    END IF
    115121
    116     IF (nqtrue < 2) THEN
    117        WRITE(lunout,*) 'nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
     122    IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
     123       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
    118124       CALL abort_gcm('infotrac_init','Not enough tracers',1)
    119125    END IF
    … …  
    159165          END DO
    160166          CLOSE(90) 
    161        ELSE ! Without tracer.def
     167       ELSE ! Without tracer.def, set default values (for Earth!)
     168         if ((nqtrue==4).and.(planet_type=="earth")) then
    162169          hadv(1) = 14
    163170          vadv(1) = 14
    … …  
    172179          vadv(4) = 10
    173180          tnom_0(4) = 'PB'
     181         else
     182           ! Error message, we need a traceur.def file
     183           write(lunout,*) trim(modname),&
     184           ': Cannot set default tracer names!'
     185           write(lunout,*) trim(modname),' Make a traceur.def file!!!'
     186           CALL abort_gcm('infotrac_init','Need a traceur.def file!',1)
     187         endif ! of if (nqtrue==4)
    174188       END IF
    175189       
    176        WRITE(lunout,*) 'Valeur de traceur.def :'
    177        WRITE(lunout,*) 'nombre de traceurs ',nqtrue
     190       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
     191       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
    178192       DO iq=1,nqtrue
    179193          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
    … …  
    217231          new_iq=new_iq+10 ! 9 tracers added
    218232       ELSE
    219           WRITE(lunout,*) 'This choice of advection schema is not available'
     233          WRITE(lunout,*) trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
    220234          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 1',1)
    221235       END IF
    … …  
    227241       nqtot = new_iq
    228242
    229        WRITE(lunout,*) 'The choice of advection schema for one or more tracers'
     243       WRITE(lunout,*) trim(modname),': The choice of advection schema for one or more tracers'
    230244       WRITE(lunout,*) 'makes it necessary to add tracers'
    231        WRITE(lunout,*) nqtrue,' is the number of true tracers'
    232        WRITE(lunout,*) nqtot, ' is the total number of tracers needed'
     245       WRITE(lunout,*) trim(modname)//': ',nqtrue,' is the number of true tracers'
     246       WRITE(lunout,*) trim(modname)//': ',nqtot, ' is the total number of tracers needed'
    233247
    234248    ELSE
    … …  
    258272          iadv(new_iq)=11
    259273       ELSE
    260           WRITE(lunout,*)'This choice of advection schema is not available'
     274          WRITE(lunout,*)trim(modname),': This choice of advection schema is not available',iq,hadv(iq),vadv(iq)
     275
    261276          CALL abort_gcm('infotrac_init','Bad choice of advection schema - 2',1)
    262277       END IF
    … …  
    265280       tname(new_iq)= tnom_0(iq)
    266281       IF (iadv(new_iq)==0) THEN
    267           ttext(new_iq)=str1(1:lnblnk(str1))
     282          ttext(new_iq)=trim(str1)
    268283       ELSE
    269           ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq))
     284          ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
    270285       END IF
    271286
    … …  
    276291             new_iq=new_iq+1
    277292             iadv(new_iq)=-20
    278              ttext(new_iq)=str2(1:lnblnk(str2))//txts(jq)
    279              tname(new_iq)=str1(1:lnblnk(str1))//txts(jq)
     293             ttext(new_iq)=trim(str2)//txts(jq)
     294             tname(new_iq)=trim(str1)//txts(jq)
    280295          END DO
    281296       ELSE IF (iadv(new_iq)==30) THEN
    … …  
    283298             new_iq=new_iq+1
    284299             iadv(new_iq)=-30
    285              ttext(new_iq)=str2(1:lnblnk(str2))//txtp(jq)
    286              tname(new_iq)=str1(1:lnblnk(str1))//txtp(jq)
     300             ttext(new_iq)=trim(str2)//txtp(jq)
     301             tname(new_iq)=trim(str1)//txtp(jq)
    287302          END DO
    288303       END IF
    … …  
    303318
    304319
    305     WRITE(lunout,*) 'Information stored in infotrac :'
    306     WRITE(lunout,*) 'iadv  niadv tname  ttext :'
     320    WRITE(lunout,*) trim(modname),': Information stored in infotrac :'
     321    WRITE(lunout,*) trim(modname),': iadv  niadv tname  ttext :'
    307322    DO iq=1,nqtot
    308        WRITE(lunout,*) iadv(iq),niadv(iq), tname(iq), ttext(iq)
     323       WRITE(lunout,*) iadv(iq),niadv(iq),&
     324       ' ',trim(tname(iq)),' ',trim(ttext(iq))
    309325    END DO
    310326
    … …  
    315331    DO iq=1,nqtot
    316332       IF (iadv(iq)/=10 .AND. iadv(iq)/=14 .AND. iadv(iq)/=0) THEN
    317           WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     333          WRITE(lunout,*)trim(modname),' STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    318334          CALL abort_gcm('infotrac_init','In this version only iadv=10 and iadv=14 is tested!',1)
    319335       ELSE IF (iadv(iq)==14 .AND. iq/=1) THEN
    320           WRITE(lunout,*)'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
     336          WRITE(lunout,*)trim(modname),'STOP : The option iadv=',iadv(iq),' is not tested in this version of LMDZ'
    321337          CALL abort_gcm('infotrac_init','In this version iadv=14 is only permitted for water vapour!',1)
    322338       END IF

  • trunk/libf/dyn3dpar/iniacademic.F

    r1 r7  
    11!
    2 ! $Id: iniacademic.F 1437 2010-09-30 08:29:10Z emillour $
     2! $Id: iniacademic.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    88      USE filtreg_mod
    99      USE infotrac, ONLY : nqtot
    10       USE control_mod
     10      USE control_mod, ONLY: day_step,planet_type
    1111#ifdef CPP_IOIPSL
    1212      USE IOIPSL
    … …  
    9595! 1. Initializations for Earth-like case
    9696! --------------------------------------
    97       if (planet_type=="earth") then
    9897c
    9998        ! initialize planet radius, rotation rate,...
    … …  
    128127          if (.not.read_start) then
    129128            phis(:)=0.
    130             q(:,:,1)=1.e-10
    131             q(:,:,2)=1.e-15
    132             q(:,:,3:nqtot)=0.
     129            q(:,:,:)=0
    133130            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
    134131          endif
    … …  
    138135          ! initializations for the academic case
    139136         
     137!         if (planet_type=="earth") then
     138
    140139          ! 1. local parameters
    141140          ! by convention, winter is in the southern hemisphere
    … …  
    219218          enddo
    220219
     220
     221!         else
     222!          write(lunout,*)"iniacademic: planet types other than earth",
     223!     &                   " not implemented (yet)."
     224!          stop
     225!         endif ! of if (planet_type=="earth")
     226
    221227          ! 3. Initialize fields (if necessary)
    222228          IF (.NOT. read_start) THEN
    … …  
    245251           
    246252            ! bulk initialization of tracers
    247             do i=1,nqtot
    248               if (i.eq.1) q(:,:,i)=1.e-10
    249               if (i.eq.2) q(:,:,i)=1.e-15
    250               if (i.gt.2) q(:,:,i)=0.
    251             enddo
     253            if (planet_type=="earth") then
     254              ! Earth: first two tracers will be water
     255              do i=1,nqtot
     256                if (i.eq.1) q(:,:,i)=1.e-10
     257                if (i.eq.2) q(:,:,i)=1.e-15
     258                if (i.gt.2) q(:,:,i)=0.
     259              enddo
     260            else
     261              q(:,:,:)=0
     262            endif ! of if (planet_type=="earth")
    252263
    253264            ! add random perturbation to temperature
    … …  
    261272            enddo
    262273
     274            ! maintain periodicity in longitude
    263275            do l=1,llm
    264276              do ij=1,ip1jmp1,iip1
    … …  
    267279            enddo
    268280
    269 c     PRINT *,' Appel test_period avec tetarappel '
    270 c     CALL  test_period ( ucov,vcov,tetarappel,q,p,phis )
    271 c     PRINT *,' Appel test_period avec teta '
    272 c     CALL  test_period ( ucov,vcov,teta,q,p,phis )
    273 
    274            ! initialize a traceur on one column
    275 !          j=jjp1*3/4
    276 !          i=iip1/2
    277 !          ij=(j-1)*iip1+i
    278 !          q(ij,:,3)=1.
    279 
    280281          ENDIF ! of IF (.NOT. read_start)
    281282        endif ! of if (iflag_phys.eq.2)
    282283       
    283       else
    284         write(lunout,*)"iniacademic: planet types other than earth",
    285      &                 " not implemented (yet)."
    286         stop
    287       endif ! of if (planet_type=="earth")
    288       return
    289284      END
    290285c-----------------------------------------------------------------------

  • trunk/libf/dyn3dpar/initfluxsto_p.F

    r1 r7  
    11!
    2 ! $Id: initfluxsto_p.F 1279 2009-12-10 09:02:56Z fairhead $
     2! $Id: initfluxsto_p.F 1438 2010-10-08 10:19:34Z jghattas $
    33!
    44      subroutine initfluxsto_p
    … …  
    203203     .              llm, nivsigs, zvertiid)
    204204c pour le fichier def
    205       nivd(1) = 1
    206       call histvert(filedid, 'sig_s', 'Niveaux sigma',
    207      .  'sigma_level',
    208      .              1, nivd, dvertiid)
    209 
     205      if (mpi_rank==0) then
     206         nivd(1) = 1
     207         call histvert(filedid, 'sig_s', 'Niveaux sigma',
     208     .        'sigma_level',
     209     .        1, nivd, dvertiid)
     210      endif
    210211C
    211212C  Appels a histdef pour la definition des variables a sauvegarder
    … …  
    282283      call histend(fileid)
    283284      call histend(filevid)
    284       call histend(filedid)
     285      if (mpi_rank==0) call histend(filedid)
    285286      if (ok_sync) then
    286287        call histsync(fileid)
    287288        call histsync(filevid)
    288         call histsync(filedid)
     289        if (mpi_rank==0) call histsync(filedid)
    289290      endif
    290291       

  • trunk/libf/dyn3dpar/integrd_p.F

    r1 r7  
    11!
    2 ! $Id: integrd_p.F 1403 2010-07-01 09:02:53Z fairhead $
     2! $Id: integrd_p.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44      SUBROUTINE integrd_p
    … …  
    66     $     dv,du,dteta,dq,dp,vcov,ucov,teta,q,ps0,masse,phis,finvmaold)
    77      USE parallel
    8       USE control_mod
     8      USE control_mod, only : planet_type
    99      IMPLICIT NONE
    1010
    … …  
    279279
    280280          CALL qminimum_p( q, nq, deltap )
    281          endif ! of if (planet_type.eq."earth")
    282281c
    283282c    .....  Calcul de la valeur moyenne, unique  aux poles pour  q .....
    … …  
    337336      ENDDO
    338337c$OMP END DO NOWAIT
     338
     339      endif ! of if (planet_type.eq."earth")
     340
    339341c
    340342c

  • trunk/libf/dyn3dpar/leapfrog_p.F

    r1 r7  
    11!
    2 ! $Id: leapfrog_p.F 1437 2010-09-30 08:29:10Z emillour $
     2! $Id: leapfrog_p.F 1446 2010-10-22 09:27:25Z emillour $
    33!
    44c
    … …  
    234234
    235235c$OMP MASTER
    236       dq=0.
     236      dq(:,:,:)=0.
    237237      CALL pression ( ip1jmp1, ap, bp, ps, p       )
    238238      CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    … …  
    596596     .        flxw,pk, iapptrac)
    597597
    598        IF (offline) THEN
    599 Cmaf stokage du flux de masse pour traceurs OFF-LINE
    600 
    601 #ifdef CPP_IOIPSL
    602            CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis,
    603      .   dtvr, itau)
    604 #endif
    605 
    606 
    607          ENDIF ! of IF (offline)
    608 c
     598C        Stokage du flux de masse pour traceurs OFF-LINE
     599         IF (offline .AND. .NOT. adjust) THEN
     600            CALL fluxstokenc_p(pbaru,pbarv,masse,teta,phi,phis,
     601     .           dtvr, itau)
     602         ENDIF
     603
    609604      ENDIF ! of IF( forward. OR . leapf )
    610605cc$OMP END PARALLEL
    … …  
    14931488c$OMP MASTER
    14941489
    1495               if (planet_type.eq."earth") then
     1490!              if (planet_type.eq."earth") then
    14961491! Write an Earth-format restart file
    14971492                CALL dynredem1_p("restart.nc",0.0,
    14981493     &                           vcov,ucov,teta,q,masse,ps)
    1499               endif ! of if (planet_type.eq."earth")
     1494!              endif ! of if (planet_type.eq."earth")
    15001495
    15011496!              CLOSE(99)
    … …  
    16861681
    16871682              IF(itau.EQ.itaufin) THEN
    1688                 if (planet_type.eq."earth") then
     1683!                if (planet_type.eq."earth") then
    16891684c$OMP MASTER
    16901685                   CALL dynredem1_p("restart.nc",0.0,
    16911686     .                               vcov,ucov,teta,q,masse,ps)
    16921687c$OMP END MASTER
    1693                 endif ! of if (planet_type.eq."earth")
     1688!                endif ! of if (planet_type.eq."earth")
    16941689              ENDIF ! of IF(itau.EQ.itaufin)
    16951690

  • trunk/libf/dyn3dpar/limit_netcdf.F90

    r1 r7  
    11!
    2 ! $Id: limit_netcdf.F90 1425 2010-09-02 13:45:23Z lguez $
     2! $Id: limit_netcdf.F90 1441 2010-10-13 13:06:56Z emillour $
    33!-------------------------------------------------------------------------------
    44!
    … …  
    9797  kappa = 0.2857143
    9898  cpp   = 1004.70885
    99   dtvr  = daysec/FLOAT(day_step)
     99  dtvr  = daysec/REAL(day_step)
    100100  CALL inigeom
    101101
    … …  
    265265
    266266  DEALLOCATE(pctsrf_t,phy_sst,phy_bil,phy_alb,phy_rug)
    267 #endif
    268 ! of #ifdef CPP_EARTH
    269267
    270268
    … …  
    592590
    593591!--- Mid-months times
    594   mid_months(1)=0.5*FLOAT(mnth(1))
     592  mid_months(1)=0.5*REAL(mnth(1))
    595593  DO k=2,nm
    596     mid_months(k)=mid_months(k-1)+0.5*FLOAT(mnth(k-1)+mnth(k))
     594    mid_months(k)=mid_months(k-1)+0.5*REAL(mnth(k-1)+mnth(k))
    597595  END DO
    598596
    … …  
    626624!-------------------------------------------------------------------------------
    627625
     626#endif
     627! of #ifdef CPP_EARTH
    628628
    629629END SUBROUTINE limit_netcdf
Note: See TracChangeset for help on using the changeset viewer.