Changeset 8


Ignore:
Timestamp:
Nov 2, 2010, 12:38:23 PM (14 years ago)
Author:
emillour
Message:

Debut de mise a jour de la dynamique parallele par rapport aux modifs dans la partie sequentielle.

Mais NON TESTE , car pas (encore) possibilite de compiler et faire tourner cas simple (type newtonien sans physique).

Voir commit_v8.log pour les details.

Ehouarn

Location:
trunk
Files:
3 added
9 edited

Legend:

Unmodified
Added
Removed

  • trunk/libf/dyn3d/leapfrog.F

    r7 r8  
    433433c      -------------------
    434434         IF (ok_strato) THEN
    435            CALL top_bound( vcov,ucov,teta,masse,dutop,dvtop,dtetatop)
     435           CALL top_bound( vcov,ucov,teta,masse,dufi,dvfi,dtetafi)
    436436         ENDIF
    437437c dqtop=0, dptop=0
    … …  
    441441          CALL addfi( dtphys, leapf, forward   ,
    442442     $                  ucov, vcov, teta , q   ,ps ,
    443      $                 dutop, dvtop, dtetatop , dqtop ,dptop  )
     443     $                 dufi, dvfi, dtetafi , dqfi ,dpfi  )
    444444c
    445445c  Diagnostique de conservation de l'énergie : difference

  • trunk/libf/dyn3dpar/caldyn0.F

    r1 r8  
    3636      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    3737      REAL ps(ip1jmp1),phis(ip1jmp1)
    38       REAL pk(iip1,jjp1,llm)
     38      REAL pk(ip1jmp1,llm)
    3939      REAL vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    4040      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
    … …  
    5151      REAL bern(ip1jmp1,llm)
    5252      REAL massebxy(ip1jm,llm), dp(ip1jmp1)
    53    
     53      REAL temp(ip1jmp1,llm),tsurpk(ip1jmp1,llm)
    5454
    5555      INTEGER   ij,l
    … …  
    8383      ENDDO
    8484
     85! ADAPTATION GCM POUR CP(T)
     86      CALL tpot2t(ip1jmp1*llm,teta,temp,pk)
     87      tsurpk = cpp*temp/pk
     88
    8589        CALL sortvarc0
    86      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
     90     $ (itau,ucov,tsurpk,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov)
    8791
    8892      RETURN

  • trunk/libf/dyn3dpar/caldyn_p.F

    r1 r8  
    88
    99      SUBROUTINE caldyn_p
    10      $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     10     $ (itau,ucov,vcov,teta,ps,masse,pk,pkf,tsurpk,phis ,
    1111     $  phi,conser,du,dv,dteta,dp,w,pbaru,pbarv,time )
    1212      USE parallel
    … …  
    4545      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm),teta(ip1jmp1,llm)
    4646      REAL ps(ip1jmp1),phis(ip1jmp1)
    47       REAL pk(iip1,jjp1,llm),pkf(ip1jmp1,llm)
     47      REAL pk(ip1jmp1,llm),pkf(ip1jmp1,llm)
     48      REAL tsurpk(ip1jmp1,llm)
    4849      REAL,SAVE :: vcont(ip1jm,llm),ucont(ip1jmp1,llm)
    4950      REAL phi(ip1jmp1,llm),masse(ip1jmp1,llm)
    … …  
    6667      REAL,SAVE :: massebxy(ip1jm,llm)
    6768      REAL,SAVE :: convm(ip1jmp1,llm)
     69!      REAL,SAVE :: temp(ip1jmp1,llm)
    6870      INTEGER   ij,l,ijb,ije,ierr
    6971
    … …  
    129131      CALL enercin_p ( vcov   , ucov  , vcont     , ucont  , ecin  )
    130132      CALL bernoui_p ( ip1jmp1, llm   , phi       , ecin   , bern  )
    131       CALL dudv2_p   ( teta  , pkf   , bern      , du     , dv    )
     133      CALL dudv2_p   ( tsurpk , pkf   , bern      , du     , dv    )
    132134
    133135#ifdef DEBUG_IO
    … …  
    184186c ym ---> exige communication collective ( aussi dans advect)
    185187        CALL sortvarc
    186      $ ( itau,ucov,teta,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov )
     188     $ (itau,ucov,tsurpk,ps,masse,pk,phis,vorpot,phi,bern,dp,time,vcov)
    187189
    188190      ENDIF

  • trunk/libf/dyn3dpar/calfis_p.F

    r1 r8  
    2727     $                  pdqfi,
    2828     $                  pdpsfi)
    29 #ifdef CPP_EARTH
     29#ifdef CPP_PHYS
    3030! Ehouarn: For now, calfis_p needs Earth physics
    3131c
    … …  
    8686c        pdufi          tendency for the natural zonal velocity (ms-1)
    8787c        pdvfi          tendency for the natural meridional velocity
    88 c        pdhfi          tendency for the potential temperature
     88c        pdhfi          tendency for the potential temperature (K/s)
    8989c        pdtsfi         tendency for the surface temperature
    9090c
    … …  
    129129      REAL pducov(iip1,jjp1,llm)
    130130      REAL pdteta(iip1,jjp1,llm)
     131! commentaire SL: pdq ne sert que pour le calcul de pcvgq,
     132! qui lui meme ne sert a rien dans la routine telle qu'elle est
     133! ecrite, et que j'ai donc commente....
    131134      REAL pdq(iip1,jjp1,llm,nqtot)
    132135      REAL flxw(iip1,jjp1,llm)  ! Flux de masse verticale sur la grille dynamique
    … …  
    146149      REAL clesphy0( longcles )
    147150
    148 #ifdef CPP_EARTH
     151#ifdef CPP_PHYS
    149152c    Local variables :
    150153c    -----------------
    … …  
    157160      REAL,ALLOCATABLE,SAVE :: zufi(:,:), zvfi(:,:)
    158161      REAL,ALLOCATABLE,SAVE :: ztfi(:,:),zqfi(:,:,:)
    159 c
    160       REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
    161       REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
     162! ADAPTATION GCM POUR CP(T)
     163      REAL,ALLOCATABLE,SAVE :: zteta(:,:)
     164      REAL,ALLOCATABLE,SAVE ::  zpk(:,:)
     165c
     166! Ces calculs ne servent pas.
     167! Si necessaire, decommenter ces variables et les calculs...
     168!      REAL,ALLOCATABLE,SAVE :: pcvgu(:,:), pcvgv(:,:)
     169!      REAL,ALLOCATABLE,SAVE :: pcvgt(:,:), pcvgq(:,:,:)
    162170c
    163171      REAL,ALLOCATABLE,SAVE :: zdufi(:,:),zdvfi(:,:)
    … …  
    272280      ALLOCATE(zufi(klon,llm), zvfi(klon,llm))
    273281      ALLOCATE(ztfi(klon,llm),zqfi(klon,llm,nqtot))
    274       ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
    275       ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
     282!      ALLOCATE(pcvgu(klon,llm), pcvgv(klon,llm))
     283!      ALLOCATE(pcvgt(klon,llm), pcvgq(klon,llm,2))
    276284      ALLOCATE(zdufi(klon,llm),zdvfi(klon,llm))
    277285      ALLOCATE(zdtfi(klon,llm),zdqfi(klon,llm,nqtot))
    … …  
    279287      ALLOCATE(zdufi2(klon+iim,llm),zdvfi2(klon+iim,llm))
    280288      ALLOCATE(flxwfi(klon,llm))
     289! ADAPTATION GCM POUR CP(T)
     290      ALLOCATE(zteta(klon,llm)
     291      ALLOCATE(zpk(klon,llm))
    281292c$OMP END MASTER
    282293c$OMP BARRIER     
    … …  
    309320
    310321
    311 c   42. pression intercouches :
     322c   42. pression intercouches et fonction d'Exner:
    312323c
    313324c   -----------------------------------------------------------------
    … …  
    332343      ENDDO
    333344c$OMP END DO NOWAIT
     345! ADAPTATION GCM POUR CP(T)
     346      DO l=1,llm
     347!CDIR ON_ADB(index_i)
     348!CDIR ON_ADB(index_j)
     349        do ig0=1,klon
     350          i=index_i(ig0)
     351          j=index_j(ig0)
     352          zpk(ig0,l)=ppk(i,j,l)
     353          zteta(ig0,l)=pteta(i,j,l)
     354        enddo
     355      ENDDO
     356c$OMP END DO NOWAIT
     357
    334358c
    335359c
    … …  
    337361c   43. temperature naturelle (en K) et pressions milieux couches .
    338362c   ---------------------------------------------------------------
     363
     364! ADAPTATION GCM POUR CP(T)
     365         call tpot2t_p(ngridmx*llm,zteta,ztfi,zpk)
     366
    339367c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    340368      DO l=1,llm
    … …  
    346374          pksurcp        = ppk(i,j,l) / cpp
    347375          zplay(ig0,l)   = preff * pksurcp ** unskap
    348           ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
     376!          ztfi(ig0,l)    = pteta(i,j,l)  * pksurcp
    349377        enddo
    350378
    … …  
    352380c$OMP END DO NOWAIT
    353381
    354 c   43.bis traceurs
     382c   43.bis traceurs (tous intensifs)
    355383c   ---------------
    356384c
    … …  
    369397         ENDDO
    370398c$OMP END DO NOWAIT     
    371       ENDDO
     399      ENDDO ! of DO iq=1,nqtot
    372400
    373401
    … …  
    504532c   Appel de la physique:
    505533c   ---------------------
     534
     535! Appel de la physique: pose probleme quand on tourne
     536! SANS physique, car physiq.F est dans le repertoire phy[]...
     537! Il faut une cle CPP_PHYS
     538
     539! Le fait que les arguments de physiq soient differents selon les planetes
     540! ne pose pas de probleme a priori.
    506541
    507542
    … …  
    626661     
    627662c$OMP BARRIER
    628      
    629       if (planet_type=="earth") then
    630 #ifdef CPP_EARTH
    631663
    632664!$OMP MASTER
    … …  
    646678
    647679
    648       CALL physiq (klon,
     680      if (planet_type=="earth") then
     681        CALL physiq (klon,
    649682     .             llm,
    650683     .             debut_split,
    … …  
    674707     .             pducov,
    675708     .             PVteta)
    676 
     709      else ! a moduler pour Mars
     710        CALL physiq (klon,
     711     .             llm,
     712     .             debut_split,
     713     .             lafin_split,
     714     .             jD_cur,
     715     .             jH_cur_split,
     716     .             zdt_split,
     717     .             zplev_omp,
     718     .             zplay_omp,
     719     .             zphi_omp,
     720     .             zphis_omp,
     721     .             presnivs_omp,
     722     .             clesphy0,
     723     .             zufi_omp,
     724     .             zvfi_omp,
     725     .             ztfi_omp,
     726     .             zqfi_omp,
     727c#ifdef INCA
     728     .             flxwfi_omp,
     729c#endif
     730     .             zdufi_omp,
     731     .             zdvfi_omp,
     732     .             zdtfi_omp,
     733     .             zdqfi_omp,
     734     .             zdpsrf_omp,
     735cIM diagnostique PVteta, Amip2         
     736     .             pducov,
     737     .             PVteta)
     738      endif ! planet_type
    677739         zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
    678740         zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
    … …  
    692754      zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
    693755
    694 #endif
    695       endif !of if (planet_type=="earth")
    696756c$OMP BARRIER
    697757
    … …  
    891951c   62. enthalpie potentielle
    892952c   ---------------------
    893      
     953
    894954      kstart=1
    895955      kend=klon
    … …  
    897957      if (is_north_pole) kstart=2
    898958      if (is_south_pole)  kend=klon-1
     959     
     960! ADAPTATION GCM POUR CP(T)
     961!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     962      DO l=1,llm
     963        ztfi(1:klon,l)=ztfi(1:klon,l)+zdtfi(1:klon,l)*dtphys
     964      ENDDO
     965!$OMP END DO
     966      call t2tpot_p(ngridmx,llm,ztfi,zteta,zpk)
     967
    899968
    900969c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    901970      DO l=1,llm
    902 
    903971!CDIR ON_ADB(index_i)
    904972!CDIR ON_ADB(index_j)
    … …  
    907975          i=index_i(ig0)
    908976          j=index_j(ig0)
    909           pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
    910           if (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
     977!          pdhfi(i,j,l) = cpp * zdtfi(ig0,l) / ppk(i,j,l)
     978          pdhfi(i,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
     979!          if (i==1) pdhfi(iip1,j,l) =  cpp * zdtfi(ig0,l) / ppk(i,j,l)
     980          if (i==1) then
     981            pdhfi(iip1,j,l) = (zteta(ig0,l) - pteta(i,j,l))/dtphys
     982          endif
    911983         enddo         
    912984
    913985        if (is_north_pole) then
    914986            DO i=1,iip1
    915               pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
     987!              pdhfi(i,1,l)    = cpp *  zdtfi(1,l)      / ppk(i, 1  ,l)
     988              pdhfi(i,1,l)    = (zteta(1,l) - pteta(i,1,l))/dtphys
    916989            enddo
    917990        endif
    … …  
    919992        if (is_south_pole) then
    920993            DO i=1,iip1
    921               pdhfi(i,jjp1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjp1,l)
     994!              pdhfi(i,jjp1,l) = cpp *  zdtfi(klon,l)/ ppk(i,jjp1,l)
     995              pdhfi(i,jjp1,l) = (zteta(klon,l) - pteta(i,jjp1,l))/dtphys
    922996            ENDDO
    923997        endif
    … …  
    9541028!      ENDDO
    9551029
    956 c   63. traceurs
     1030c   63. traceurs (tous en intensifs)
    9571031c   ------------
    9581032C     initialisation des tendances
    … …  
    11151189      stop
    11161190#endif
    1117 ! of #ifdef CPP_EARTH
     1191! of #ifdef CPP_PHYS
    11181192      RETURN
    11191193      END

  • trunk/libf/dyn3dpar/comconst.h

    r1 r8  
    1212     &                   ,tau_top_bound,                                &
    1313     & daylen,year_day,molmass
    14 
     14      COMMON/cpdetvenus/nu_venus,t0_venus
    1515
    1616      INTEGER im,jm,lllm,imp1,jmp1,lllmm1,lllmp1,lcl
    … …  
    3535      REAL molmass ! (g/mol) molar mass of the atmosphere
    3636
     37      REAL nu_venus,t0_venus ! coeffs needed for Cp(T), Venus atmosphere
     38
    3739
    3840!-----------------------------------------------------------------------

  • trunk/libf/dyn3dpar/gcm.F

    r7 r8  
    190190      call Read_Distrib
    191191! Ehouarn : temporarily (?) keep this only for Earth
    192       if (planet_type.eq."earth") then
    193 #ifdef CPP_EARTH
     192!      if (planet_type.eq."earth") then
     193!#ifdef CPP_EARTH
     194#ifdef CPP_PHYS
    194195        CALL Init_Phys_lmdz(iim,jjp1,llm,mpi_size,distrib_phys)
    195196#endif
    196       endif ! of if (planet_type.eq."earth")
     197!      endif ! of if (planet_type.eq."earth")
    197198      CALL set_bands
    198 #ifdef CPP_EARTH
    199 ! Ehouarn: For now only Earth physics is parallel
     199#ifdef CPP_PHYS
     200! Ehouarn: NB: For now only Earth physics is parallel
    200201      CALL Init_interface_dyn_phys
    201202#endif
    … …  
    210211
    211212! Ehouarn : temporarily (?) keep this only for Earth
    212       if (planet_type.eq."earth") then
    213 #ifdef CPP_EARTH
     213!      if (planet_type.eq."earth") then
     214!#ifdef CPP_EARTH
     215#ifdef CPP_PHYS
    214216c$OMP PARALLEL
    215217      call InitComgeomphy
    216218c$OMP END PARALLEL
    217219#endif
    218       endif ! of if (planet_type.eq."earth")
     220!      endif ! of if (planet_type.eq."earth")
     221
     222c Initialisations pour Cp(T) Venus
     223      call ini_cpdet
    219224
    220225c-----------------------------------------------------------------------
    … …  
    276281        endif
    277282
    278 !        if (planet_type.eq."earth") then
    279 ! Load an Earth-format start file
     283        if (planet_type.eq."mars") then
     284! POUR MARS, METTRE UNE FONCTION A PART, genre dynetat0_mars
     285         abort_message = 'dynetat0_mars A FAIRE'
     286         call abort_gcm(modname,abort_message,0)
     287        else
    280288         CALL dynetat0("start.nc",vcov,ucov,
    281289     &              teta,q,masse,ps,phis, time_0)
    282 !        endif ! of if (planet_type.eq."earth")
     290        endif ! of if (planet_type.eq."mars")
    283291
    284292c       write(73,*) 'ucov',ucov
    … …  
    445453         WRITE(lunout,*)
    446454     .       'GCM: WARNING!!! vitesse verticale nulle dans la physique'
    447 ! Earth:
    448          if (planet_type.eq."earth") then
    449 #ifdef CPP_EARTH
     455! Initialisation de la physique: pose probleme quand on tourne
     456! SANS physique, car iniphysiq.F est dans le repertoire phy[]...
     457! Il faut une cle CPP_PHYS
     458#ifdef CPP_PHYS
    450459         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    451460     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    452 #endif
    453          endif ! of if (planet_type.eq."earth")
     461#endif ! CPP_PHYS
    454462         call_iniphys=.false.
    455463      ENDIF ! of IF (call_iniphys.and.(iflag_phys.eq.1))
    … …  
    486494#endif
    487495
    488 !      if (planet_type.eq."earth") then
    489 ! Write an Earth-format restart file
     496      if (planet_type.eq."mars") then
     497! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem0_mars
     498         abort_message = 'dynredem0_mars A FAIRE'
     499         call abort_gcm(modname,abort_message,0)
     500      else
    490501        CALL dynredem0_p("restart.nc", day_end, phis)
    491 !      endif
     502      endif ! of if (planet_type.eq."mars")
    492503
    493504      ecripar = .TRUE.

  • trunk/libf/dyn3dpar/infotrac.F90

    r7 r8  
    6565    INTEGER :: nqtrue  ! number of tracers read from tracer.def, without higer order of moment
    6666    INTEGER :: iq, new_iq, iiq, jq, ierr
    67 
     67 
    6868    character(len=*),parameter :: modname="infotrac_init"
    6969!-----------------------------------------------------------------------
    … …  
    8484    descrq(30)='PRA'
    8585   
    86 
    87     IF (config_inca=='none') THEN
     86    IF (planet_type=='earth') THEN
     87     IF (config_inca=='none') THEN
    8888       type_trac='lmdz'
     89     ELSE
     90       type_trac='inca'
     91     END IF
    8992    ELSE
    90        type_trac='inca'
    91     END IF
     93     type_trac='plnt'  ! planets... May want to dissociate between each later.
     94    ENDIF
    9295
    9396!-----------------------------------------------------------------------
    … …  
    97100!
    98101!-----------------------------------------------------------------------
    99     IF (type_trac == 'lmdz') THEN
     102    IF (planet_type=='earth') THEN
     103     IF (type_trac == 'lmdz') THEN
    100104       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
    101105       IF(ierr.EQ.0) THEN
    102           WRITE(lunout,*) trim(modname),': Open traceur.def : ok'
     106          WRITE(lunout,*) 'Open traceur.def : ok'
    103107          READ(90,*) nqtrue
    104108       ELSE
    105           WRITE(lunout,*) trim(modname),': Problem in opening traceur.def'
    106           WRITE(lunout,*) trim(modname),': WARNING using defaut values'
     109          WRITE(lunout,*) 'Problem in opening traceur.def'
     110          WRITE(lunout,*) 'ATTENTION using defaut values'
    107111          nqtrue=4 ! Defaut value
    108112       END IF
    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
    117     ELSE
     113       ! For Earth, water vapour & liquid tracers are not in the physics
     114       nbtr=nqtrue-2
     115     ELSE
    118116       ! nbtr has been read from INCA by init_cont_lmdz() in gcm.F
    119117       nqtrue=nbtr+2
    120     END IF
    121 
    122     IF ((planet_type=="earth").and.(nqtrue < 2)) THEN
     118     END IF
     119
     120     IF (nqtrue < 2) THEN
    123121       WRITE(lunout,*) trim(modname),': nqtrue=',nqtrue, ' is not allowded. 2 tracers is the minimum'
    124122       CALL abort_gcm('infotrac_init','Not enough tracers',1)
    125     END IF
     123     END IF
     124
     125    ELSE  ! not Earth
     126       OPEN(90,file='traceur.def',form='formatted',status='old', iostat=ierr)
     127       IF(ierr.EQ.0) THEN
     128          WRITE(lunout,*) 'Open traceur.def : ok'
     129          READ(90,*) nqtrue
     130       ELSE
     131          WRITE(lunout,*) 'Problem in opening traceur.def'
     132          WRITE(lunout,*) 'ATTENTION using defaut values: nqtrue=1'
     133          nqtrue=1 ! Defaut value
     134       END IF
     135       ! Other planets (for now); we have the same number of tracers
     136       ! in the dynamics than in the physics
     137       nbtr=nqtrue
     138     
     139    ENDIF  ! planet_type
    126140!
    127141! Allocate variables depending on nqtrue and nbtr
    … …  
    158172!    Get choice of advection schema from file tracer.def or from INCA
    159173!---------------------------------------------------------------------
    160     IF (type_trac == 'lmdz') THEN
     174    IF (planet_type=='earth') THEN
     175     IF (type_trac == 'lmdz') THEN
    161176       IF(ierr.EQ.0) THEN
    162177          ! Continue to read tracer.def
    … …  
    194209       END DO
    195210
    196     ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
     211     ELSE  ! type_trac=inca : config_inca='aero' ou 'chem'
    197212! le module de chimie fournit les noms des traceurs
    198213! et les schemas d'advection associes.
    … …  
    213228       END DO
    214229
    215     END IF ! type_trac
     230     END IF ! type_trac
     231
     232    ELSE  ! not Earth
     233       IF(ierr.EQ.0) THEN
     234          ! Continue to read tracer.def
     235          DO iq=1,nqtrue
     236             READ(90,999) hadv(iq),vadv(iq),tnom_0(iq)
     237          END DO
     238          CLOSE(90) 
     239       ELSE ! Without tracer.def
     240          hadv(1) = 10
     241          vadv(1) = 10
     242          tnom_0(1) = 'dummy'
     243       END IF
     244       
     245       WRITE(lunout,*) trim(modname),': Valeur de traceur.def :'
     246       WRITE(lunout,*) trim(modname),': nombre de traceurs ',nqtrue
     247       DO iq=1,nqtrue
     248          WRITE(lunout,*) hadv(iq),vadv(iq),tnom_0(iq)
     249       END DO
     250
     251    ENDIF  ! planet_type
    216252
    217253!-----------------------------------------------------------------------
    … …  
    280316       tname(new_iq)= tnom_0(iq)
    281317       IF (iadv(new_iq)==0) THEN
    282           ttext(new_iq)=trim(str1)
     318          ttext(new_iq)=str1(1:lnblnk(str1))
    283319       ELSE
    284           ttext(new_iq)=trim(tnom_0(iq))//descrq(iadv(new_iq))
     320          ttext(new_iq)=str1(1:lnblnk(str1))//descrq(iadv(new_iq))
    285321       END IF
    286322

  • trunk/libf/dyn3dpar/leapfrog_p.F

    r7 r8  
    9090      REAL,SAVE :: phi(ip1jmp1,llm)                  ! geopotentiel
    9191      REAL,SAVE :: w(ip1jmp1,llm)                    ! vitesse verticale
     92! ADAPTATION GCM POUR CP(T)
     93      REAL,SAVE :: temp(ip1jmp1,llm)                 ! temperature 
     94      REAL,SAVE :: tsurpk(ip1jmp1,llm)               ! cpp*T/pk 
    9295
    9396c variables dynamiques intermediaire pour le transport
    … …  
    475478     &                                jj_nb_caldyn,0,0,TestRequest)
    476479        enddo
     480! ADAPTATION GCM POUR CP(T)
     481         call Register_SwapFieldHallo(temp,temp,ip1jmp1,llm,
     482     &                                jj_Nb_caldyn,0,0,TestRequest)
     483         call Register_SwapFieldHallo(tsurpk,tsurpk,ip1jmp1,llm,
     484     &                                jj_Nb_caldyn,0,0,TestRequest)
    477485
    478486         call SetDistrib(jj_nb_caldyn)
    … …  
    505513       call Register_Hallo(pks,ip1jmp1,1,1,1,1,1,TestRequest)
    506514       call Register_Hallo(p,ip1jmp1,llmp1,1,1,1,1,TestRequest)
     515! ADAPTATION GCM POUR CP(T)
     516       call Register_Hallo(temp,ip1jmp1,llm,1,1,1,1,TestRequest)
     517       call Register_Hallo(tsurpk,ip1jmp1,llm,1,1,1,1,TestRequest)
    507518       
    508519c       do j=1,nqtot
    … …  
    543554      True_itau=True_itau+1
    544555
    545 c$OMP MASTER
     556! ADAPTATION GCM POUR CP(T)
     557      call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
     558      ijb=ij_begin
     559      ije=ij_end
     560!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     561      do l=1,llm
     562        tsurpk(ijb:ije,llm)=cpp*temp(ijb:ije,llm)/pk(ijb:ije,llm)
     563      enddo
     564!$OMP END DO
     565
    546566      IF (prt_level>9) THEN
    547567        WRITE(lunout,*)"leapfrog_p: Iteration No",True_itau
    … …  
    551571      call start_timer(timer_caldyn)
    552572
    553       CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
    554 
     573! ADAPTATION GCM POUR CP(T)
     574!      CALL geopot_p  ( ip1jmp1, teta  , pk , pks,  phis  , phi   )
     575      CALL geopot_p  ( ip1jmp1, tsurpk  , pk , pks,  phis  , phi   )
    555576     
    556577      call VTb(VTcaldyn)
    … …  
    561582!      CALL FTRACE_REGION_BEGIN("caldyn")
    562583      time = jD_cur + jH_cur
     584! ADAPTATION GCM POUR CP(T)
     585!      CALL caldyn_p
     586!     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     587!     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
    563588      CALL caldyn_p
    564      $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,phis ,
     589     $  ( itau,ucov,vcov,teta,ps,masse,pk,pkf,tsurpk,phis,
    565590     $    phi,conser,du,dv,dteta,dp,w, pbaru,pbarv, time )
    566591
    … …  
    701726
    702727
    703 c   Inbterface avec les routines de phylmd (phymars ... )
     728c   Interface avec les routines de phylmd (phymars ... )
    704729c   -----------------------------------------------------
    705730
    … …  
    10751100
    10761101c   dissipation
     1102! ADAPTATION GCM POUR CP(T)
     1103        call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
    10771104
    10781105!        CALL FTRACE_REGION_BEGIN("dissip")
    … …  
    10851112        DO l=1,llm
    10861113          ucov(ijb:ije,l)=ucov(ijb:ije,l)+dudis(ijb:ije,l)
     1114          dudis(ijb:ije,l)=dudis(ijb:ije,l)/dtdiss   ! passage en (m/s)/s
    10871115        ENDDO
    10881116c$OMP END DO NOWAIT       
    … …  
    10911119        DO l=1,llm
    10921120          vcov(ijb:ije,l)=vcov(ijb:ije,l)+dvdis(ijb:ije,l)
     1121          dvdis(ijb:ije,l)=dvdis(ijb:ije,l)/dtdiss   ! passage en (m/s)/s
    10931122        ENDDO
    10941123c$OMP END DO NOWAIT       
    1095 
    1096 c       teta=teta+dtetadis
    10971124
    10981125
    … …  
    11241151            do l=1,llm
    11251152              do ij=ijb,ije
    1126                 dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
     1153! ADAPTATION GCM POUR CP(T)
     1154!                dtetaecdt(ij,l)= (ecin0(ij,l)-ecin(ij,l))/ pk(ij,l)
     1155!                dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
     1156                temp(ij,l)=temp(ij,l) +
     1157     &                      (ecin0(ij,l)-ecin(ij,l))/cpdet(temp(ij,l))
     1158              enddo
     1159            enddo
     1160c$OMP END DO
     1161            call t2tpot_p(ip1jmp1,llm,temp,ztetaec,pk)
     1162c$OMP DO SCHEDULE(STATIC,OMP_CHUNK)           
     1163            do l=1,llm
     1164              do ij=ijb,ije
     1165                dtetaecdt(ij,l)=ztetaec(ij,l)-teta(ij,l)
    11271166                dtetadis(ij,l)=dtetadis(ij,l)+dtetaecdt(ij,l)
    11281167              enddo
    11291168            enddo
    1130 c$OMP END DO NOWAIT           
     1169c$OMP END DO NOWAIT
    11311170       endif ! of if (dissip_conservative)
    11321171
    … …  
    11371176           do ij=ijb,ije
    11381177              teta(ij,l)=teta(ij,l)+dtetadis(ij,l)
     1178              dtetadis(ij,l)=dtetadis(ij,l)/dtdiss   ! passage en K/s
    11391179           enddo
    11401180         enddo
    … …  
    13721412
    13731413c ATTENTION!!! bilan_dyn_p ne marche probablement pas avec OpenMP
    1374               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    1375      ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1414!              CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1415!     ,             ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1416c les traceurs ne sont pas sortis, trop lourd.
     1417c Peut changer eventuellement si besoin.
     1418                 CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
     1419     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
     1420     &                 du,dudis,duspg,dufi)
    13761421c$OMP END MASTER
    13771422              ENDIF !ok_dynzon
    … …  
    14111456c$OMP MASTER
    14121457              nbetat = nbetatdem
    1413               CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
     1458
     1459! ADAPTATION GCM POUR CP(T)
     1460      call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
     1461      ijb=ij_begin
     1462      ije=ij_end
     1463!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1464      do l=1,llm
     1465        tsurpk(ijb:ije,llm)=cpp*temp(ijb:ije,llm)/pk(ijb:ije,llm)
     1466      enddo
     1467!$OMP END DO
     1468!              CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
     1469      CALL geopot_p  ( ip1jmp1, tsurpk  , pk , pks,  phis  , phi   )
    14141470       
    14151471cym        unat=0.
    … …  
    14881544c$OMP MASTER
    14891545
    1490 !              if (planet_type.eq."earth") then
     1546              if (planet_type.eq."mars") then
     1547! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem1_mars
     1548                abort_message = 'dynredem1_mars A FAIRE'
     1549                call abort_gcm(modname,abort_message,0)
     1550              else
    14911551! Write an Earth-format restart file
    14921552                CALL dynredem1_p("restart.nc",0.0,
    14931553     &                           vcov,ucov,teta,q,masse,ps)
    1494 !              endif ! of if (planet_type.eq."earth")
     1554              endif ! of if (planet_type.eq."mars")
    14951555
    14961556!              CLOSE(99)
    … …  
    15781638!               CALL writedynav_p(histaveid, itau,vcov ,
    15791639!     ,                          ucov,teta,pk,phi,q,masse,ps,phis)
    1580                CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
    1581      ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1640!               CALL bilan_dyn_p(2,dtvr*iperiod,dtvr*day_step*periodav,
     1641!     ,           ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,q)
     1642c les traceurs ne sont pas sortis, trop lourd.
     1643c Peut changer eventuellement si besoin.
     1644                 CALL bilan_dyn_p(dtvr*iperiod,dtvr*day_step*periodav,
     1645     &                 ps,masse,pk,pbaru,pbarv,teta,phi,ucov,vcov,
     1646     &                 du,dudis,duspg,dufi)
     1647
    15821648c$OMP END MASTER
    15831649               END IF !ok_dynzon
    … …  
    16141680c$OMP MASTER
    16151681                nbetat = nbetatdem
    1616                 CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
     1682! ADAPTATION GCM POUR CP(T)
     1683                call tpot2t_p(ip1jmp1,llm,teta,temp,pk)
     1684                ijb=ij_begin
     1685                ije=ij_end
     1686!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1687                do l=1,llm
     1688                  tsurpk(ijb:ije,llm)=cpp*temp(ijb:ije,llm)/
     1689     &                                             pk(ijb:ije,llm)
     1690                enddo
     1691!$OMP END DO
     1692!                CALL geopot_p(ip1jmp1,teta,pk,pks,phis,phi)
     1693                CALL geopot_p(ip1jmp1,tsurpk,pk,pks,phis,phi)
    16171694
    16181695cym        unat=0.
    … …  
    16811758
    16821759              IF(itau.EQ.itaufin) THEN
    1683 !                if (planet_type.eq."earth") then
     1760                if (planet_type.eq."mars") then
     1761! POUR MARS, METTRE UNE FONCTION A PART, genre dynredem1_mars
     1762                  abort_message = 'dynredem1_mars A FAIRE'
     1763                  call abort_gcm(modname,abort_message,0)
     1764                else
    16841765c$OMP MASTER
    16851766                   CALL dynredem1_p("restart.nc",0.0,
    16861767     .                               vcov,ucov,teta,q,masse,ps)
    16871768c$OMP END MASTER
    1688 !                endif ! of if (planet_type.eq."earth")
     1769                endif ! of if (planet_type.eq."mars")
    16891770              ENDIF ! of IF(itau.EQ.itaufin)
    16901771

  • trunk/libf/dyn3dpar/vlspltqs_p.F

    r1 r8  
    6969      REAL rtt,retv,r2es,r3les,r3ies,r4les,r4ies,play
    7070      REAL ptarg,pdelarg,foeew,zdelta
    71       REAL tempe(ip1jmp1)
     71!      REAL tempe(ip1jmp1)
     72! ADAPTATION GCM POUR CP(T)
     73      REAL tempe(ip1jmp1,llm)
     74
    7275      INTEGER ijb,ije
    7376      type(request) :: MyRequest1
    … …  
    9194c-- approximation: au milieu des couches play(l)=(p(l)+p(l+1))/2
    9295c   pour eviter une exponentielle.
     96
     97! ADAPTATION GCM POUR CP(T)
     98! probablement a revoir...
     99      call tpot2t_p(ip1jmp1,llm,teta,tempe,pk)
     100
    93101
    94102      call SetTag(MyRequest1,100)
    … …  
    102110       
    103111        DO l = 1, llm
     112!         DO ij = ijb, ije
     113!          tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
     114!         ENDDO
    104115         DO ij = ijb, ije
    105           tempe(ij) = teta(ij,l) * pk(ij,l) /cpp
    106          ENDDO
    107          DO ij = ijb, ije
    108           zdelta = MAX( 0., SIGN(1., rtt - tempe(ij)) )
     116          zdelta = MAX( 0., SIGN(1., rtt - tempe(ij,l)) )
    109117          play   = 0.5*(p(ij,l)+p(ij,l+1))
    110           qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij),zdelta) / play )
     118          qsat(ij,l) = MIN(0.5, r2es* FOEEW(tempe(ij,l),zdelta) / play )
    111119          qsat(ij,l) = qsat(ij,l) / ( 1. - retv * qsat(ij,l) )
    112120         ENDDO
Note: See TracChangeset for help on using the changeset viewer.