Changeset 1657 for LMDZ5


Ignore:
Timestamp:
Oct 2, 2012, 5:57:45 PM (12 years ago)
Author:
Laurent Fairhead
Message:

Phasage de la dynamique parallèle localisée (petite mémoire) avec la branche LMDZ4V5.0-dev (fin de la branche)
Validation effectuée par comparaison des fichiers de sorties debug (u, v, t, q, masse, etc ...) d'une simulation sans physique
faite avec la version du modèle donnée paY. Meurdesoif et la version phasée avec la r1399 (fin de la branche LMDZ4V5.0-dev)

Phasing of the localised (low memory) parallel dynamics package with the LMDZ4V5.0-dev version of LMDZ
Validation consisted in comparing output debug files (u, v, t, q, masse, etc... ) of a no physics simulation
run with the version of the code given by Y. Meurdesoif and this version phased with r1399 (end of the LMDZ4V5.0-dev branch)

Location:
LMDZ5/trunk/libf/dyn3dmem
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/dyn3dmem/calfis_loc.F

    r1632 r1657  
    11!
    2 ! $Id: calfis_p.F 1299 2010-01-20 14:27:21Z fairhead $
     2! $Id$
    33!
    44C
    … …  
    108108#include "comvert.h"
    109109#include "comgeom2.h"
     110#include "iniprint.h"
    110111#ifdef CPP_MPI
    111112      include 'mpif.h'
    … …  
    180181      REAL,SAVE,ALLOCATABLE ::  flxwfi_omp(:,:)     ! Flux de masse verticale sur la grille physiq
    181182
     183!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     184! Introduction du splitting (FH)
     185! Question pour Yann :
     186! J'ai été surpris au début que les tableaux zufi_omp, zdufi_omp n'co soitent
     187! en SAVE. Je crois comprendre que c'est parce que tu voulais qu'il
     188! soit allocatable (plutot par exemple que de passer une dimension
     189! dépendant du process en argument des routines) et que, du coup,
     190! le SAVE évite d'avoir à refaire l'allocation à chaque appel.
     191! Tu confirmes ?
     192! J'ai suivi le même principe pour les zdufic_omp
     193! Mais c'est surement bien que tu controles.
     194!
     195
     196      REAL,ALLOCATABLE,SAVE :: zdufic_omp(:,:)
     197      REAL,ALLOCATABLE,SAVE :: zdvfic_omp(:,:)
     198      REAL,ALLOCATABLE,SAVE :: zdtfic_omp(:,:)
     199      REAL,ALLOCATABLE,SAVE :: zdqfic_omp(:,:,:)
     200      REAL jH_cur_split,zdt_split
     201      LOGICAL debut_split,lafin_split
     202      INTEGER isplit
     203!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     204
    182205c$OMP THREADPRIVATE(zplev_omp,zplay_omp,zphi_omp,zphis_omp,
    183206c$OMP+                 presnivs_omp,zufi_omp,zvfi_omp,ztfi_omp,
    184207c$OMP+                 zqfi_omp,zdufi_omp,zdvfi_omp,
    185 c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp)       
     208c$OMP+                 zdtfi_omp,zdqfi_omp,zdpsrf_omp,flxwfi_omp,
     209c$OMP+                 zdufic_omp,zdvfic_omp,zdtfic_omp,zdqfic_omp)       
    186210
    187211      LOGICAL,SAVE :: first_omp=.true.
    … …  
    235259        debut = .TRUE.
    236260        IF (ngridmx.NE.2+(jjm-1)*iim) THEN
    237          PRINT*,'STOP dans calfis'
    238          PRINT*,'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
    239          PRINT*,'  ngridmx  jjm   iim   '
    240          PRINT*,ngridmx,jjm,iim
    241          STOP
     261          write(lunout,*) 'STOP dans calfis'
     262          write(lunout,*) 
     263     &   'La dimension ngridmx doit etre egale a 2 + (jjm-1)*iim'
     264          write(lunout,*) '  ngridmx  jjm   iim   '
     265          write(lunout,*) ngridmx,jjm,iim
     266          STOP
    242267        ENDIF
    243268c$OMP MASTER
    … …  
    533558        allocate(zdtfi_omp(klon,llm))
    534559        allocate(zdqfi_omp(klon,llm,nqtot))
     560        allocate(zdufic_omp(klon,llm))
     561        allocate(zdvfic_omp(klon,llm))
     562        allocate(zdtfic_omp(klon,llm))
     563        allocate(zdqfic_omp(klon,llm,nqtot))
    535564        allocate(zdpsrf_omp(klon))
    536565        allocate(flxwfi_omp(klon,llm))
    … …  
    635664      if (planet_type=="earth") then
    636665#ifdef CPP_EARTH
     666
     667
     668!$OMP MASTER
     669      write(lunout,*) 'PHYSIQUE AVEC NSPLIT_PHYS=',nsplit_phys
     670!$OMP END MASTER
     671      zdt_split=dtphys/nsplit_phys
     672      zdufic_omp(:,:)=0.
     673      zdvfic_omp(:,:)=0.
     674      zdtfic_omp(:,:)=0.
     675      zdqfic_omp(:,:,:)=0.
     676
     677      do isplit=1,nsplit_phys
     678
     679         jH_cur_split=jH_cur+(isplit-1) * dtvr / (daysec *nsplit_phys)
     680         debut_split=debut.and.isplit==1
     681         lafin_split=lafin.and.isplit==nsplit_phys
     682
     683
    637684      CALL physiq (klon,
    638685     .             llm,
    639      .             debut,
    640      .             lafin,
     686     .             debut_split,
     687     .             lafin_split,
    641688     .             jD_cur,
    642      .             jH_cur,
    643      .             dtphys,
     689     .             jH_cur_split,
     690     .             zdt_split,
    644691     .             zplev_omp,
    645692     .             zplay_omp,
    … …  
    663710     .             pducov,
    664711     .             PVteta)
     712
     713         zufi_omp(:,:)=zufi_omp(:,:)+zdufi_omp(:,:)*zdt_split
     714         zvfi_omp(:,:)=zvfi_omp(:,:)+zdvfi_omp(:,:)*zdt_split
     715         ztfi_omp(:,:)=ztfi_omp(:,:)+zdtfi_omp(:,:)*zdt_split
     716         zqfi_omp(:,:,:)=zqfi_omp(:,:,:)+zdqfi_omp(:,:,:)*zdt_split
     717
     718         zdufic_omp(:,:)=zdufic_omp(:,:)+zdufi_omp(:,:)
     719         zdvfic_omp(:,:)=zdvfic_omp(:,:)+zdvfi_omp(:,:)
     720         zdtfic_omp(:,:)=zdtfic_omp(:,:)+zdtfi_omp(:,:)
     721         zdqfic_omp(:,:,:)=zdqfic_omp(:,:,:)+zdqfi_omp(:,:,:)
     722
     723      enddo
     724
     725      zdufi_omp(:,:)=zdufic_omp(:,:)/nsplit_phys
     726      zdvfi_omp(:,:)=zdvfic_omp(:,:)/nsplit_phys
     727      zdtfi_omp(:,:)=zdtfic_omp(:,:)/nsplit_phys
     728      zdqfi_omp(:,:,:)=zdqfic_omp(:,:,:)/nsplit_phys
     729
    665730#endif
    666731      endif !of if (planet_type=="earth")
    … …  
    11161181#else
    11171182      write(*,*) "calfis_p: for now can only work with parallel physics"
     1183      write(lunout,*)
     1184   & "calfis_p: for now can only work with parallel physics"
    11181185      stop
    11191186#endif

  • LMDZ5/trunk/libf/dyn3dmem/conf_gcm.F

    r1632 r1657  
    11!
    2 ! $Id: conf_gcm.F 1299 2010-01-20 14:27:21Z fairhead $
     2! $Id: conf_gcm.F 1357 2010-04-14 14:03:19Z emillour $
    33!
    44c
    … …  
    174174       CALL getin('day_step',day_step)
    175175
     176!Config  Key  = nsplit_phys
     177!Config  Desc = nombre d'iteration de la physique
     178!Config  Def  = 240
     179!Config  Help = nombre d'itration de la physique
     180!
     181       nsplit_phys = 1
     182       CALL getin('nsplit_phys',nsplit_phys)
     183
    176184!Config  Key  = iperiod
    177185!Config  Desc = periode pour le pas Matsuno
    … …  
    594602      CALL getin('ok_dynzon',ok_dynzon)
    595603
     604!Config  Key  = ok_dyn_ins
     605!Config  Desc = sorties instantanees dans la dynamique
     606!Config  Def  = n
     607!Config  Help =
     608!Config         
     609      ok_dyn_ins = .FALSE.
     610      CALL getin('ok_dyn_ins',ok_dyn_ins)
     611
     612!Config  Key  = ok_dyn_ave
     613!Config  Desc = sorties moyennes dans la dynamique
     614!Config  Def  = n
     615!Config  Help =
     616!Config         
     617      ok_dyn_ave = .FALSE.
     618      CALL getin('ok_dyn_ave',ok_dyn_ave)
    596619
    597620      write(lunout,*)' #########################################'
    … …  
    604627      write(lunout,*)' day_step = ', day_step
    605628      write(lunout,*)' iperiod = ', iperiod
     629      write(lunout,*)' nsplit_phys = ', nsplit_phys
    606630      write(lunout,*)' iconser = ', iconser
    607631      write(lunout,*)' iecri = ', iecri
    … …  
    633657      write(lunout,*)' config_inca = ', config_inca
    634658      write(lunout,*)' ok_dynzon = ', ok_dynzon
     659      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
     660      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
    635661
    636662      RETURN
    … …  
    765791      ok_dynzon = .FALSE.
    766792      CALL getin('ok_dynzon',ok_dynzon)
     793
     794!Config  Key  = ok_dyn_ins
     795!Config  Desc = sorties instantanees dans la dynamique
     796!Config  Def  = n
     797!Config  Help =
     798!Config         
     799      ok_dyn_ins = .FALSE.
     800      CALL getin('ok_dyn_ins',ok_dyn_ins)
     801
     802!Config  Key  = ok_dyn_ave
     803!Config  Desc = sorties moyennes dans la dynamique
     804!Config  Def  = n
     805!Config  Help =
     806!Config         
     807      ok_dyn_ave = .FALSE.
     808      CALL getin('ok_dyn_ave',ok_dyn_ave)
    767809
    768810!Config  Key  = use_filtre_fft
    … …  
    859901      write(lunout,*)' config_inca = ', config_inca
    860902      write(lunout,*)' ok_dynzon = ', ok_dynzon
     903      write(lunout,*)' ok_dyn_ins = ', ok_dyn_ins
     904      write(lunout,*)' ok_dyn_ave = ', ok_dyn_ave
    861905      write(lunout,*)' use_filtre_fft = ', use_filtre_fft
    862906      write(lunout,*)' use_mpi_alloc = ', use_mpi_alloc

  • LMDZ5/trunk/libf/dyn3dmem/control_mod.F90

    r1632 r1657  
    1111
    1212  REAL    :: periodav
    13   INTEGER :: nday,day_step,iperiod,iapp_tracvl
     13  INTEGER :: nday,day_step,iperiod,iapp_tracvl,nsplit_phys
    1414  INTEGER :: iconser,iecri,idissip,iphysiq,iecrimoy
    1515  INTEGER :: dayref,anneeref, raz_date, ip_ebil_dyn
    16   LOGICAL :: offline, output_grads_dyn
     16  LOGICAL :: offline
    1717  CHARACTER (len=4)  :: config_inca
    18   CHARACTER (len=10) :: planet_type
     18  CHARACTER (len=10) :: planet_type ! planet type ('earth','mars',...)
     19  LOGICAL output_grads_dyn ! output dynamics diagnostics in
     20                           ! binary grads file 'dyn.dat' (y/n)
     21  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file
     22  LOGICAL ok_dyn_ins ! output instantaneous values of fields
     23                     ! in the dynamics in NetCDF files dyn_hist*nc
     24  LOGICAL ok_dyn_ave ! output averaged values of fields in the dynamics
     25                     ! in NetCDF files dyn_hist*ave.nc
    1926
    2027  LOGICAL ok_dynzon  ! output zonal transports in dynzon.nc file

  • LMDZ5/trunk/libf/dyn3dmem/dynetat0.F

    r1632 r1657  
    11!
    2 ! $Header$
     2! $Id $
    33!
    44      SUBROUTINE dynetat0(fichnom,vcov,ucov,
    55     .                    teta,q,masse,ps,phis,time)
     6
    67      USE infotrac
    78      IMPLICIT NONE
    … …  
    3334#include "serre.h"
    3435#include "logic.h"
     36#include "iniprint.h"
    3537
    3638c   Arguments:
    … …  
    5254
    5355c-----------------------------------------------------------------------
     56
    5457c  Ouverture NetCDF du fichier etat initial
    5558
    5659      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
    5760      IF (ierr.NE.NF_NOERR) THEN
    58         write(6,*)' Pb d''ouverture du fichier start.nc'
    59         write(6,*)' ierr = ', ierr
     61        write(lunout,*)'dynetat0: Pb d''ouverture du fichier start.nc'
     62        write(lunout,*)' ierr = ', ierr
    6063        CALL ABORT
    6164      ENDIF
    … …  
    6467      ierr = NF_INQ_VARID (nid, "controle", nvarid)
    6568      IF (ierr .NE. NF_NOERR) THEN
    66          PRINT*, "dynetat0: Le champ <controle> est absent"
     69         write(lunout,*)"dynetat0: Le champ <controle> est absent"
    6770         CALL abort
    6871      ENDIF
    … …  
    7376#endif
    7477      IF (ierr .NE. NF_NOERR) THEN
    75          PRINT*, "dynetat0: Lecture echoue pour <controle>"
     78         write(lunout,*)"dynetat0: Lecture echoue pour <controle>"
    7679         CALL abort
    7780      ENDIF
    … …  
    119122c
    120123c
    121       PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
     124      write(lunout,*)'dynetat0: rad,omeg,g,cpp,kappa',
     125     &               rad,omeg,g,cpp,kappa
    122126
    123127      IF(   im.ne.iim           )  THEN
    … …  
    134138      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
    135139      IF (ierr .NE. NF_NOERR) THEN
    136          PRINT*, "dynetat0: Le champ <rlonu> est absent"
     140         write(lunout,*)"dynetat0: Le champ <rlonu> est absent"
    137141         CALL abort
    138142      ENDIF
    … …  
    143147#endif
    144148      IF (ierr .NE. NF_NOERR) THEN
    145          PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
     149         write(lunout,*)"dynetat0: Lecture echouee pour <rlonu>"
    146150         CALL abort
    147151      ENDIF
    … …  
    149153      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
    150154      IF (ierr .NE. NF_NOERR) THEN
    151          PRINT*, "dynetat0: Le champ <rlatu> est absent"
     155         write(lunout,*)"dynetat0: Le champ <rlatu> est absent"
    152156         CALL abort
    153157      ENDIF
    … …  
    158162#endif
    159163      IF (ierr .NE. NF_NOERR) THEN
    160          PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
     164         write(lunout,*)"dynetat0: Lecture echouee pour <rlatu>"
    161165         CALL abort
    162166      ENDIF
    … …  
    164168      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
    165169      IF (ierr .NE. NF_NOERR) THEN
    166          PRINT*, "dynetat0: Le champ <rlonv> est absent"
     170         write(lunout,*)"dynetat0: Le champ <rlonv> est absent"
    167171         CALL abort
    168172      ENDIF
    … …  
    173177#endif
    174178      IF (ierr .NE. NF_NOERR) THEN
    175          PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
     179         write(lunout,*)"dynetat0: Lecture echouee pour <rlonv>"
    176180         CALL abort
    177181      ENDIF
    … …  
    179183      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
    180184      IF (ierr .NE. NF_NOERR) THEN
    181          PRINT*, "dynetat0: Le champ <rlatv> est absent"
     185         write(lunout,*)"dynetat0: Le champ <rlatv> est absent"
    182186         CALL abort
    183187      ENDIF
    … …  
    188192#endif
    189193      IF (ierr .NE. NF_NOERR) THEN
    190          PRINT*, "dynetat0: Lecture echouee pour rlatv"
     194         write(lunout,*)"dynetat0: Lecture echouee pour rlatv"
    191195         CALL abort
    192196      ENDIF
    … …  
    194198      ierr = NF_INQ_VARID (nid, "cu", nvarid)
    195199      IF (ierr .NE. NF_NOERR) THEN
    196          PRINT*, "dynetat0: Le champ <cu> est absent"
     200         write(lunout,*)"dynetat0: Le champ <cu> est absent"
    197201         CALL abort
    198202      ENDIF
    … …  
    203207#endif
    204208      IF (ierr .NE. NF_NOERR) THEN
    205          PRINT*, "dynetat0: Lecture echouee pour <cu>"
     209         write(lunout,*)"dynetat0: Lecture echouee pour <cu>"
    206210         CALL abort
    207211      ENDIF
    … …  
    209213      ierr = NF_INQ_VARID (nid, "cv", nvarid)
    210214      IF (ierr .NE. NF_NOERR) THEN
    211          PRINT*, "dynetat0: Le champ <cv> est absent"
     215         write(lunout,*)"dynetat0: Le champ <cv> est absent"
    212216         CALL abort
    213217      ENDIF
    … …  
    218222#endif
    219223      IF (ierr .NE. NF_NOERR) THEN
    220          PRINT*, "dynetat0: Lecture echouee pour <cv>"
     224         write(lunout,*)"dynetat0: Lecture echouee pour <cv>"
    221225         CALL abort
    222226      ENDIF
    … …  
    224228      ierr = NF_INQ_VARID (nid, "aire", nvarid)
    225229      IF (ierr .NE. NF_NOERR) THEN
    226          PRINT*, "dynetat0: Le champ <aire> est absent"
     230         write(lunout,*)"dynetat0: Le champ <aire> est absent"
    227231         CALL abort
    228232      ENDIF
    … …  
    233237#endif
    234238      IF (ierr .NE. NF_NOERR) THEN
    235          PRINT*, "dynetat0: Lecture echouee pour <aire>"
     239         write(lunout,*)"dynetat0: Lecture echouee pour <aire>"
    236240         CALL abort
    237241      ENDIF
    … …  
    239243      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
    240244      IF (ierr .NE. NF_NOERR) THEN
    241          PRINT*, "dynetat0: Le champ <phisinit> est absent"
     245         write(lunout,*)"dynetat0: Le champ <phisinit> est absent"
    242246         CALL abort
    243247      ENDIF
    … …  
    248252#endif
    249253      IF (ierr .NE. NF_NOERR) THEN
    250          PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
     254         write(lunout,*)"dynetat0: Lecture echouee pour <phisinit>"
    251255         CALL abort
    252256      ENDIF
    … …  
    254258      ierr = NF_INQ_VARID (nid, "temps", nvarid)
    255259      IF (ierr .NE. NF_NOERR) THEN
    256          PRINT*, "dynetat0: Le champ <temps> est absent"
     260         write(lunout,*)"dynetat0: Le champ <temps> est absent"
    257261         CALL abort
    258262      ENDIF
    … …  
    263267#endif
    264268      IF (ierr .NE. NF_NOERR) THEN
    265          PRINT*, "dynetat0: Lecture echouee <temps>"
     269         write(lunout,*)"dynetat0: Lecture echouee <temps>"
    266270         CALL abort
    267271      ENDIF
    … …  
    269273      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
    270274      IF (ierr .NE. NF_NOERR) THEN
    271          PRINT*, "dynetat0: Le champ <ucov> est absent"
     275         write(lunout,*)"dynetat0: Le champ <ucov> est absent"
    272276         CALL abort
    273277      ENDIF
    … …  
    278282#endif
    279283      IF (ierr .NE. NF_NOERR) THEN
    280          PRINT*, "dynetat0: Lecture echouee pour <ucov>"
     284         write(lunout,*)"dynetat0: Lecture echouee pour <ucov>"
    281285         CALL abort
    282286      ENDIF
    … …  
    284288      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
    285289      IF (ierr .NE. NF_NOERR) THEN
    286          PRINT*, "dynetat0: Le champ <vcov> est absent"
     290         write(lunout,*)"dynetat0: Le champ <vcov> est absent"
    287291         CALL abort
    288292      ENDIF
    … …  
    293297#endif
    294298      IF (ierr .NE. NF_NOERR) THEN
    295          PRINT*, "dynetat0: Lecture echouee pour <vcov>"
     299         write(lunout,*)"dynetat0: Lecture echouee pour <vcov>"
    296300         CALL abort
    297301      ENDIF
    … …  
    299303      ierr = NF_INQ_VARID (nid, "teta", nvarid)
    300304      IF (ierr .NE. NF_NOERR) THEN
    301          PRINT*, "dynetat0: Le champ <teta> est absent"
     305         write(lunout,*)"dynetat0: Le champ <teta> est absent"
    302306         CALL abort
    303307      ENDIF
    … …  
    308312#endif
    309313      IF (ierr .NE. NF_NOERR) THEN
    310          PRINT*, "dynetat0: Lecture echouee pour <teta>"
    311          CALL abort
    312       ENDIF
    313 
    314 
     314         write(lunout,*)"dynetat0: Lecture echouee pour <teta>"
     315         CALL abort
     316      ENDIF
     317
     318
     319      IF(nqtot.GE.1) THEN
    315320      DO iq=1,nqtot
    316321        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    317322        IF (ierr .NE. NF_NOERR) THEN
    318            PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
    319            PRINT*, "          Il est donc initialise a zero"
     323           write(lunout,*)"dynetat0: Le champ <"//tname(iq)//
     324     &                    "> est absent"
     325           write(lunout,*)"          Il est donc initialise a zero"
    320326           q(:,:,iq)=0.
    321327        ELSE
    … …  
    326332#endif
    327333          IF (ierr .NE. NF_NOERR) THEN
    328              PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
    329              CALL abort
     334            write(lunout,*)"dynetat0: Lecture echouee pour "//tname(iq)
     335            CALL abort
    330336          ENDIF
    331337        ENDIF
    332338      ENDDO
     339      ENDIF
    333340
    334341      ierr = NF_INQ_VARID (nid, "masse", nvarid)
    335342      IF (ierr .NE. NF_NOERR) THEN
    336          PRINT*, "dynetat0: Le champ <masse> est absent"
     343         write(lunout,*)"dynetat0: Le champ <masse> est absent"
    337344         CALL abort
    338345      ENDIF
    … …  
    343350#endif
    344351      IF (ierr .NE. NF_NOERR) THEN
    345          PRINT*, "dynetat0: Lecture echouee pour <masse>"
     352         write(lunout,*)"dynetat0: Lecture echouee pour <masse>"
    346353         CALL abort
    347354      ENDIF
    … …  
    349356      ierr = NF_INQ_VARID (nid, "ps", nvarid)
    350357      IF (ierr .NE. NF_NOERR) THEN
    351          PRINT*, "dynetat0: Le champ <ps> est absent"
     358         write(lunout,*)"dynetat0: Le champ <ps> est absent"
    352359         CALL abort
    353360      ENDIF
    … …  
    358365#endif
    359366      IF (ierr .NE. NF_NOERR) THEN
    360          PRINT*, "dynetat0: Lecture echouee pour <ps>"
     367         write(lunout,*)"dynetat0: Lecture echouee pour <ps>"
    361368         CALL abort
    362369      ENDIF

  • LMDZ5/trunk/libf/dyn3dmem/dynetat0_loc.F

    r1632 r1657  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE dynetat0_loc(fichnom,vcov,ucov,
    … …  
    3434#include "serre.h"
    3535#include "logic.h"
     36#include "iniprint.h"
    3637
    3738c   Arguments:
    … …  
    6162      ierr = NF_OPEN (fichnom, NF_NOWRITE,nid)
    6263      IF (ierr.NE.NF_NOERR) THEN
    63         write(6,*)' Pb d''ouverture du fichier start.nc'
    64         write(6,*)' ierr = ', ierr
     64        write(lunout,*)
     65     &  'dynetat0_loc: Pb d''ouverture du fichier start.nc'
     66        write(lunout,*)' ierr = ', ierr
    6567        CALL ABORT
    6668      ENDIF
    … …  
    6971      ierr = NF_INQ_VARID (nid, "controle", nvarid)
    7072      IF (ierr .NE. NF_NOERR) THEN
    71          PRINT*, "dynetat0: Le champ <controle> est absent"
     73         write(lunout,*)"dynetat0_loc: Le champ <controle> est absent"
    7274         CALL abort
    7375      ENDIF
    … …  
    7880#endif
    7981      IF (ierr .NE. NF_NOERR) THEN
    80          PRINT*, "dynetat0: Lecture echoue pour <controle>"
     82         write(lunout,*)"dynetat0_loc: Lecture echoue pour <controle>"
    8183         CALL abort
    8284      ENDIF
    … …  
    124126c
    125127c
    126       PRINT*,'rad,omeg,g,cpp,kappa',rad,omeg,g,cpp,kappa
     128      write(lunout,*)'dynetat0_loc: rad,omeg,g,cpp,kappa',
     129     &               rad,omeg,g,cpp,kappa
    127130
    128131      IF(   im.ne.iim           )  THEN
    … …  
    139142      ierr = NF_INQ_VARID (nid, "rlonu", nvarid)
    140143      IF (ierr .NE. NF_NOERR) THEN
    141          PRINT*, "dynetat0: Le champ <rlonu> est absent"
     144         write(lunout,*)"dynetat0_loc: Le champ <rlonu> est absent"
    142145         CALL abort
    143146      ENDIF
    … …  
    148151#endif
    149152      IF (ierr .NE. NF_NOERR) THEN
    150          PRINT*, "dynetat0: Lecture echouee pour <rlonu>"
     153         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonu>"
    151154         CALL abort
    152155      ENDIF
    … …  
    154157      ierr = NF_INQ_VARID (nid, "rlatu", nvarid)
    155158      IF (ierr .NE. NF_NOERR) THEN
    156          PRINT*, "dynetat0: Le champ <rlatu> est absent"
     159         write(lunout,*)"dynetat0_loc: Le champ <rlatu> est absent"
    157160         CALL abort
    158161      ENDIF
    … …  
    163166#endif
    164167      IF (ierr .NE. NF_NOERR) THEN
    165          PRINT*, "dynetat0: Lecture echouee pour <rlatu>"
     168         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlatu>"
    166169         CALL abort
    167170      ENDIF
    … …  
    169172      ierr = NF_INQ_VARID (nid, "rlonv", nvarid)
    170173      IF (ierr .NE. NF_NOERR) THEN
    171          PRINT*, "dynetat0: Le champ <rlonv> est absent"
     174         write(lunout,*)"dynetat0_loc: Le champ <rlonv> est absent"
    172175         CALL abort
    173176      ENDIF
    … …  
    178181#endif
    179182      IF (ierr .NE. NF_NOERR) THEN
    180          PRINT*, "dynetat0: Lecture echouee pour <rlonv>"
     183         write(lunout,*)"dynetat0_loc: Lecture echouee pour <rlonv>"
    181184         CALL abort
    182185      ENDIF
    … …  
    184187      ierr = NF_INQ_VARID (nid, "rlatv", nvarid)
    185188      IF (ierr .NE. NF_NOERR) THEN
    186          PRINT*, "dynetat0: Le champ <rlatv> est absent"
     189         write(lunout,*)"dynetat0_loc: Le champ <rlatv> est absent"
    187190         CALL abort
    188191      ENDIF
    … …  
    193196#endif
    194197      IF (ierr .NE. NF_NOERR) THEN
    195          PRINT*, "dynetat0: Lecture echouee pour rlatv"
     198         write(lunout,*)"dynetat0_loc: Lecture echouee pour rlatv"
    196199         CALL abort
    197200      ENDIF
    … …  
    199202      ierr = NF_INQ_VARID (nid, "cu", nvarid)
    200203      IF (ierr .NE. NF_NOERR) THEN
    201          PRINT*, "dynetat0: Le champ <cu> est absent"
     204         write(lunout,*)"dynetat0_loc: Le champ <cu> est absent"
    202205         CALL abort
    203206      ENDIF
    … …  
    208211#endif
    209212      IF (ierr .NE. NF_NOERR) THEN
    210          PRINT*, "dynetat0: Lecture echouee pour <cu>"
     213         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cu>"
    211214         CALL abort
    212215      ENDIF
    … …  
    214217      ierr = NF_INQ_VARID (nid, "cv", nvarid)
    215218      IF (ierr .NE. NF_NOERR) THEN
    216          PRINT*, "dynetat0: Le champ <cv> est absent"
     219         write(lunout,*)"dynetat0_loc: Le champ <cv> est absent"
    217220         CALL abort
    218221      ENDIF
    … …  
    223226#endif
    224227      IF (ierr .NE. NF_NOERR) THEN
    225          PRINT*, "dynetat0: Lecture echouee pour <cv>"
     228         write(lunout,*)"dynetat0_loc: Lecture echouee pour <cv>"
    226229         CALL abort
    227230      ENDIF
    … …  
    229232      ierr = NF_INQ_VARID (nid, "aire", nvarid)
    230233      IF (ierr .NE. NF_NOERR) THEN
    231          PRINT*, "dynetat0: Le champ <aire> est absent"
     234         write(lunout,*)"dynetat0_loc: Le champ <aire> est absent"
    232235         CALL abort
    233236      ENDIF
    … …  
    238241#endif
    239242      IF (ierr .NE. NF_NOERR) THEN
    240          PRINT*, "dynetat0: Lecture echouee pour <aire>"
     243         write(lunout,*)"dynetat0_loc: Lecture echouee pour <aire>"
    241244         CALL abort
    242245      ENDIF
    … …  
    246249      ierr = NF_INQ_VARID (nid, "phisinit", nvarid)
    247250      IF (ierr .NE. NF_NOERR) THEN
    248          PRINT*, "dynetat0: Le champ <phisinit> est absent"
     251         write(lunout,*)"dynetat0_loc: Le champ <phisinit> est absent"
    249252         CALL abort
    250253      ENDIF
    … …  
    255258#endif
    256259      IF (ierr .NE. NF_NOERR) THEN
    257          PRINT*, "dynetat0: Lecture echouee pour <phisinit>"
     260         write(lunout,*)"dynetat0_loc: Lecture echouee pour <phisinit>"
    258261         CALL abort
    259262      ENDIF
    … …  
    263266      ierr = NF_INQ_VARID (nid, "temps", nvarid)
    264267      IF (ierr .NE. NF_NOERR) THEN
    265          PRINT*, "dynetat0: Le champ <temps> est absent"
     268         write(lunout,*)"dynetat0_loc: Le champ <temps> est absent"
    266269         CALL abort
    267270      ENDIF
    … …  
    272275#endif
    273276      IF (ierr .NE. NF_NOERR) THEN
    274          PRINT*, "dynetat0: Lecture echouee <temps>"
     277         write(lunout,*)"dynetat0_loc: Lecture echouee <temps>"
    275278         CALL abort
    276279      ENDIF
    … …  
    278281      ierr = NF_INQ_VARID (nid, "ucov", nvarid)
    279282      IF (ierr .NE. NF_NOERR) THEN
    280          PRINT*, "dynetat0: Le champ <ucov> est absent"
     283         write(lunout,*)"dynetat0_loc: Le champ <ucov> est absent"
    281284         CALL abort
    282285      ENDIF
    … …  
    290293#endif
    291294      IF (ierr .NE. NF_NOERR) THEN
    292          PRINT*, "dynetat0: Lecture echouee pour <ucov>"
     295         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ucov>"
    293296         CALL abort
    294297      ENDIF
    … …  
    300303      ierr = NF_INQ_VARID (nid, "vcov", nvarid)
    301304      IF (ierr .NE. NF_NOERR) THEN
    302          PRINT*, "dynetat0: Le champ <vcov> est absent"
     305         write(lunout,*)"dynetat0_loc: Le champ <vcov> est absent"
    303306         CALL abort
    304307      ENDIF
    … …  
    309312#endif
    310313      IF (ierr .NE. NF_NOERR) THEN
    311          PRINT*, "dynetat0: Lecture echouee pour <vcov>"
     314         write(lunout,*)"dynetat0_loc: Lecture echouee pour <vcov>"
    312315         CALL abort
    313316      ENDIF
    … …  
    318321      ierr = NF_INQ_VARID (nid, "teta", nvarid)
    319322      IF (ierr .NE. NF_NOERR) THEN
    320          PRINT*, "dynetat0: Le champ <teta> est absent"
     323         write(lunout,*)"dynetat0_loc: Le champ <teta> est absent"
    321324         CALL abort
    322325      ENDIF
    … …  
    327330#endif
    328331      IF (ierr .NE. NF_NOERR) THEN
    329          PRINT*, "dynetat0: Lecture echouee pour <teta>"
     332         write(lunout,*)"dynetat0_loc: Lecture echouee pour <teta>"
    330333         CALL abort
    331334      ENDIF
    … …  
    339342        ierr =  NF_INQ_VARID (nid, tname(iq), nvarid)
    340343        IF (ierr .NE. NF_NOERR) THEN
    341            PRINT*, "dynetat0: Le champ <"//tname(iq)//"> est absent"
    342            PRINT*, "          Il est donc initialise a zero"
    343            q_glo(:,:)=0.
     344           write(lunout,*)"dynetat0_loc: Le champ <"//tname(iq)//
     345     &                    "> est absent"
     346           write(lunout,*)"          Il est donc initialise a zero"
     347           q(:,:,iq)=0.
    344348        ELSE
    345349#ifdef NC_DOUBLE
    … …  
    349353#endif
    350354          IF (ierr .NE. NF_NOERR) THEN
    351              PRINT*, "dynetat0: Lecture echouee pour "//tname(iq)
    352              CALL abort
     355            write(lunout,*)
     356     &      "dynetat0_loc: Lecture echouee pour "//tname(iq)
     357            CALL abort
    353358          ENDIF
    354359        ENDIF
    … …  
    361366      ierr = NF_INQ_VARID (nid, "masse", nvarid)
    362367      IF (ierr .NE. NF_NOERR) THEN
    363          PRINT*, "dynetat0: Le champ <masse> est absent"
     368         write(lunout,*)"dynetat0_loc: Le champ <masse> est absent"
    364369         CALL abort
    365370      ENDIF
    … …  
    370375#endif
    371376      IF (ierr .NE. NF_NOERR) THEN
    372          PRINT*, "dynetat0: Lecture echouee pour <masse>"
     377         write(lunout,*)"dynetat0_loc: Lecture echouee pour <masse>"
    373378         CALL abort
    374379      ENDIF
    … …  
    379384      ierr = NF_INQ_VARID (nid, "ps", nvarid)
    380385      IF (ierr .NE. NF_NOERR) THEN
    381          PRINT*, "dynetat0: Le champ <ps> est absent"
     386         write(lunout,*)"dynetat0_loc: Le champ <ps> est absent"
    382387         CALL abort
    383388      ENDIF
    … …  
    388393#endif
    389394      IF (ierr .NE. NF_NOERR) THEN
    390          PRINT*, "dynetat0: Lecture echouee pour <ps>"
     395         write(lunout,*)"dynetat0_loc: Lecture echouee pour <ps>"
    391396         CALL abort
    392397      ENDIF

  • LMDZ5/trunk/libf/dyn3dmem/dynredem_loc.F

    r1632 r1657  
    2727#include "description.h"
    2828#include "serre.h"
     29#include "iniprint.h"
    2930
    3031c   Arguments:
    … …  
    6465      if (mpi_rank==0) then
    6566     
    66       modname='dynredem0_p'
     67      modname='dynredem0_loc'
    6768
    6869#ifdef CPP_IOIPSL
    … …  
    132133      ierr = NF_CREATE(fichnom, NF_CLOBBER, nid)
    133134      IF (ierr.NE.NF_NOERR) THEN
    134          WRITE(6,*)" Pb d ouverture du fichier "//fichnom
    135          WRITE(6,*)' ierr = ', ierr
     135         write(lunout,*)"dynredem0: Pb d ouverture du fichier "
     136     &                  //trim(fichnom)
     137         write(lunout,*)' ierr = ', ierr
    136138         CALL ABORT
    137139      ENDIF
    … …  
    514516      ierr = NF_CLOSE(nid) ! fermer le fichier
    515517
    516 
    517       PRINT*,'iim,jjm,llm,iday_end',iim,jjm,llm,iday_end
    518       PRINT*,'rad,omeg,g,cpp,kappa',
    519      ,        rad,omeg,g,cpp,kappa
     518      write(lunout,*)'dynredem_loc: iim,jjm,llm,iday_end',
     519     &               iim,jjm,llm,iday_end
     520      write(lunout,*)'dynredem_loc: rad,omeg,g,cpp,kappa',
     521     &        rad,omeg,g,cpp,kappa
    520522
    521523      endif  ! mpi_rank==0
    … …  
    540542#include "comgeom.h"
    541543#include "temps.h"
     544#include "iniprint.h"
    542545
    543546      INTEGER l
    … …  
    579582!$OMP MASTER     
    580583      if (mpi_rank==0) then
    581       modname = 'dynredem1'
     584      modname = 'dynredem1_loc'
    582585      ierr = NF_OPEN(fichnom, NF_WRITE, nid)
    583586      IF (ierr .NE. NF_NOERR) THEN
    584          PRINT*, "Pb. d ouverture "//fichnom
     587         write(lunout,*)"dynredem1: Pb. d ouverture "//trim(fichnom)
    585588         CALL abort
    586589      ENDIF
    … …  
    591594      ierr = NF_INQ_VARID(nid, "temps", nvarid)
    592595      IF (ierr .NE. NF_NOERR) THEN
    593          print *, NF_STRERROR(ierr)
     596         write(lunout,*) NF_STRERROR(ierr)
    594597         abort_message='Variable temps n est pas definie'
    595598         CALL abort_gcm(modname,abort_message,ierr)
    … …  
    600603      ierr = NF_PUT_VAR1_REAL (nid,nvarid,nb,time)
    601604#endif
    602       PRINT*, "Enregistrement pour ", nb, time
     605      write(lunout,*) "dynredem1_loc: Enregistrement pour ", nb, time
    603606
    604607c

  • LMDZ5/trunk/libf/dyn3dmem/exner_hyb.F

    r1632 r1657  
    11!
    2 ! $Header$
     2! $Id$
    33!
    44      SUBROUTINE  exner_hyb ( ngrid, ps, p,alpha,beta, pks, pk, pkf )
    … …  
    5151      REAL SSUM
    5252c
     53
     54      if (llm.eq.1) then
     55        ! Specific behaviour for Shallow Water (1 vertical layer) case
    5356     
     57        ! Sanity checks
     58        if (kappa.ne.1) then
     59          call abort_gcm("exner_hyb",
     60     &    "kappa!=1 , but running in Shallow Water mode!!",42)
     61        endif
     62        if (cpp.ne.r) then
     63        call abort_gcm("exner_hyb",
     64     &    "cpp!=r , but running in Shallow Water mode!!",42)
     65        endif
     66       
     67        ! Compute pks(:),pk(:),pkf(:)
     68       
     69        DO   ij  = 1, ngrid
     70          pks(ij) = (cpp/preff) * ps(ij)
     71          pk(ij,1) = .5*pks(ij)
     72        ENDDO
     73       
     74        CALL SCOPY   ( ngrid * llm, pk, 1, pkf, 1 )
     75        CALL filtreg ( pkf, jmp1, llm, 2, 1, .TRUE., 1 )
     76       
     77        ! our work is done, exit routine
     78        return
     79      endif ! of if (llm.eq.1)
     80
     81     
    5482      unpl2k    = 1.+ 2.* kappa
    5583c

  • LMDZ5/trunk/libf/dyn3dmem/exner_hyb_loc.F

    r1632 r1657  
     1c
     2c $Id$
     3c
    14      SUBROUTINE  exner_hyb_loc(ngrid, ps, p,alpha,beta, pks,pk,pkf)
    25c
    … …  
    5659c
    5760c$OMP BARRIER           
     61
     62      if (llm.eq.1) then
     63        ! Specific behaviour for Shallow Water (1 vertical layer) case
     64     
     65        ! Sanity checks
     66        if (kappa.ne.1) then
     67          call abort_gcm("exner_hyb",
     68     &    "kappa!=1 , but running in Shallow Water mode!!",42)
     69        endif
     70        if (cpp.ne.r) then
     71        call abort_gcm("exner_hyb",
     72     &    "cpp!=r , but running in Shallow Water mode!!",42)
     73        endif
     74       
     75        ! Compute pks(:),pk(:),pkf(:)
     76        ijb=ij_begin
     77        ije=ij_end
     78!$OMP DO SCHEDULE(STATIC)
     79        DO ij=ijb, ije
     80          pks(ij)=(cpp/preff)*ps(ij)
     81          pk(ij,1) = .5*pks(ij)
     82          pkf(ij,1)=pk(ij,1)
     83        ENDDO
     84!$OMP ENDDO
     85
     86!$OMP MASTER
     87      if (pole_nord) then
     88        DO  ij   = 1, iim
     89          ppn(ij) = aire(   ij   ) * pks(  ij     )
     90        ENDDO
     91        xpn      = SSUM(iim,ppn,1) /apoln
     92 
     93        DO ij   = 1, iip1
     94          pks(   ij     )  =  xpn
     95          pk(ij,1) = .5*pks(ij)
     96          pkf(ij,1)=pk(ij,1)
     97        ENDDO
     98      endif
     99     
     100      if (pole_sud) then
     101        DO  ij   = 1, iim
     102          pps(ij) = aire(ij+ip1jm) * pks(ij+ip1jm )
     103        ENDDO
     104        xps      = SSUM(iim,pps,1) /apols
     105 
     106        DO ij   = 1, iip1
     107          pks( ij+ip1jm )  =  xps
     108          pk(ij+ip1jm,1)=.5*pks(ij+ip1jm)
     109          pkf(ij+ip1jm,1)=pk(ij+ip1jm,1)
     110        ENDDO
     111      endif
     112!$OMP END MASTER
     113
     114        jjb=jj_begin
     115        jje=jj_end
     116        CALL filtreg_p ( pkf,jjb_u,jje_u,jjb,jje, jmp1, llm,
     117     &                 2, 1, .TRUE., 1 )
     118
     119        ! our work is done, exit routine
     120        return
     121      endif ! of if (llm.eq.1)
     122
     123
    58124      unpl2k    = 1.+ 2.* kappa
    59125c

  • LMDZ5/trunk/libf/dyn3dmem/gcm.F

    r1632 r1657  
    11!
    2 ! $Id: gcm.F 1316 2010-02-22 14:51:12Z acozic $
     2! $Id: gcm.F 1397 2010-06-02 12:57:39Z emillour $
    33!
    44c
    … …  
    7070#include "description.h"
    7171#include "serre.h"
    72 #include "com_io_dyn.h"
     72!#include "com_io_dyn.h"
    7373#include "iniprint.h"
    7474#include "tracstoke.h"
     75#ifdef INCA
     76! Only INCA needs these informations (from the Earth's physics)
    7577#include "indicesol.h"
     78#endif
    7679
    7780      INTEGER         longcles
    … …  
    273276      if (read_start) then
    274277      ! we still need to run iniacademic to initialize some
    275       ! constants & fields, if we run the 'newtonian' case:
    276         if (iflag_phys.eq.2) then
     278      ! constants & fields, if we run the 'newtonian' or 'SW' cases:
     279        if (iflag_phys.ne.1) then
    277280          CALL iniacademic(vcov,ucov,teta,q,masse,ps,phis,time_0)
    278281        endif
    279 !#ifdef CPP_IOIPSL
     282
    280283        if (planet_type.eq."earth") then
    281284#ifdef CPP_EARTH
    282285! Load an Earth-format start file
    283286         CALL dynetat0_loc("start.nc",vcov,ucov,
    284      .              teta,q,masse,ps,phis, time_0)
     287     &              teta,q,masse,ps,phis, time_0)
     288#else
     289        ! SW model also has Earth-format start files
     290        ! (but can be used without the CPP_EARTH directive)
     291          if (iflag_phys.eq.0) then
     292            CALL dynetat0_loc("start.nc",vcov,ucov,
     293     &              teta,q,masse,ps,phis, time_0)
     294          endif
    285295#endif
    286296        endif ! of if (planet_type.eq."earth")
    … …  
    326336C on remet le calendrier à zero si demande
    327337c
    328       if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
     338      IF (raz_date == 1) THEN
     339        annee_ref = anneeref
     340        day_ref = dayref
     341        day_ini = dayref
     342        itau_dyn = 0
     343        itau_phy = 0
     344        time_0 = 0.
     345        write(lunout,*)
     346     .   'GCM: On reinitialise a la date lue dans gcm.def'
     347      ELSE IF (annee_ref .ne. anneeref .or. day_ref .ne. dayref) THEN
    329348        write(lunout,*)
    330349     .  'GCM: Attention les dates initiales lues dans le fichier'
    … …  
    332351     .  ' restart ne correspondent pas a celles lues dans '
    333352        write(lunout,*)' gcm.def'
    334         write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
    335         write(lunout,*)' day_ref=',day_ref," dayref=",dayref
    336         if (raz_date .ne. 1) then
    337           write(lunout,*)
    338      .    'GCM: On garde les dates du fichier restart'
    339         else
    340           annee_ref = anneeref
    341           day_ref = dayref
    342           day_ini = dayref
    343           itau_dyn = 0
    344           itau_phy = 0
    345           time_0 = 0.
    346           write(lunout,*)
    347      .   'GCM: On reinitialise a la date lue dans gcm.def'
    348         endif
    349       ELSE
    350         raz_date = 0
    351       endif
     353        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     354        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     355        write(lunout,*)' Pas de remise a zero'
     356      ENDIF
     357c      if (annee_ref .ne. anneeref .or. day_ref .ne. dayref) then
     358c        write(lunout,*)
     359c     .  'GCM: Attention les dates initiales lues dans le fichier'
     360c        write(lunout,*)
     361c     .  ' restart ne correspondent pas a celles lues dans '
     362c        write(lunout,*)' gcm.def'
     363c        write(lunout,*)' annee_ref=',annee_ref," anneeref=",anneeref
     364c        write(lunout,*)' day_ref=',day_ref," dayref=",dayref
     365c        if (raz_date .ne. 1) then
     366c          write(lunout,*)
     367c     .    'GCM: On garde les dates du fichier restart'
     368c        else
     369c          annee_ref = anneeref
     370c          day_ref = dayref
     371c          day_ini = dayref
     372c          itau_dyn = 0
     373c          itau_phy = 0
     374c          time_0 = 0.
     375c          write(lunout,*)
     376c     .   'GCM: On reinitialise a la date lue dans gcm.def'
     377c        endif
     378c      ELSE
     379c        raz_date = 0
     380c      endif
    352381
    353382#ifdef CPP_IOIPSL
    … …  
    428457         if (planet_type.eq."earth") then
    429458#ifdef CPP_EARTH
    430          CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys ,
     459         CALL iniphysiq(ngridmx,llm,daysec,day_ini,dtphys/nsplit_phys ,
    431460     ,                latfi,lonfi,airefi,zcufi,zcvfi,rad,g,r,cpp     )
    432461#endif
    … …  
    473502
    474503#ifdef CPP_IOIPSL
    475       if ( 1.eq.1) then
    476504      time_step = zdtvr
    477       t_ops = iecri * daysec
    478       t_wrt = iecri * daysec
    479 !      CALL inithist_p(dynhist_file,day_ref,annee_ref,time_step,
    480 !     .              t_ops, t_wrt, histid, histvid)
     505      IF (mpi_rank==0) then
     506        if (ok_dyn_ins) then
     507          ! initialize output file for instantaneous outputs
     508          ! t_ops = iecri * daysec ! do operations every t_ops
     509          t_ops =((1.0*iecri)/day_step) * daysec 
     510          t_wrt = daysec ! iecri * daysec ! write output every t_wrt
     511          t_wrt = daysec ! iecri * daysec ! write output every t_wrt
     512          CALL inithist(day_ref,annee_ref,time_step,
     513     &                  t_ops,t_wrt)
     514        endif
    481515
    482516      IF (ok_dyn_ave) THEN
    483          t_ops = iperiod * time_step
    484          t_wrt = periodav * daysec
     517         ! initialize output file for averaged outputs
     518         t_ops = iperiod * time_step ! do operations every t_ops
     519         t_wrt = periodav * daysec   ! write output every t_wrt
    485520         CALL initdynav_loc(day_ref,annee_ref,time_step,t_ops,t_wrt)
    486       END IF
     521        END IF
     522      ENDIF
    487523      dtav = iperiod*dtvr/daysec
    488       endif
    489 
    490 
    491524#endif
    492525! #endif of #ifdef CPP_IOIPSL

  • LMDZ5/trunk/libf/dyn3dmem/iniacademic.F

    r1632 r1657  
    11!
    2 ! $Id: iniacademic.F 1299 2010-01-20 14:27:21Z fairhead $
     2! $Id: iniacademic.F 1363 2010-04-16 09:50:10Z emillour $
    33!
    44c
    … …  
    88      USE filtreg_mod
    99      USE infotrac, ONLY : nqtot
     10      USE control_mod
     11 
    1012
    1113c%W%    %G%
    … …  
    3133c
    3234c=======================================================================
    33       USE control_mod
    3435      IMPLICIT NONE
    3536c-----------------------------------------------------------------------
    … …  
    4647#include "temps.h"
    4748#include "iniprint.h"
     49#include "logic.h"
    4850
    4951c   Arguments:
    … …  
    5557      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) ! vents covariants
    5658      REAL teta(ip1jmp1,llm)                 ! temperature potentielle
    57       REAL q(ip1jmp1,llm,nqtot)              ! champs advectes
     59      REAL q(ip1jmp1,llm,nqtot)               ! champs advectes
    5860      REAL ps(ip1jmp1)                       ! pression  au sol
    5961      REAL masse(ip1jmp1,llm)                ! masse d'air
    … …  
    8486        time_0=0.
    8587        day_ref=0
    86         annee_ref=0
     88        annee_ref=0
    8789
    8890        im         = iim
    … …  
    105107        ang0       = 0.
    106108
     109        if (llm.eq.1) then
     110          ! specific initializations for the shallow water case
     111          kappa=1
     112        endif
     113       
    107114        CALL iniconst
    108115        CALL inigeom
    109116        CALL inifilr
    110117
    111         ps=0.
    112         phis=0.
     118        if (llm.eq.1) then
     119          ! initialize fields for the shallow water case, if required
     120          if (.not.read_start) then
     121            phis(:)=0.
     122            q(:,:,1)=1.e-10
     123            q(:,:,2)=1.e-15
     124            q(:,:,3:nqtot)=0.
     125            CALL sw_case_williamson91_6(vcov,ucov,teta,masse,ps)
     126          endif
     127        endif
     128
     129        if (iflag_phys.eq.2) then
     130          ! initializations for the academic case
     131          ps(:)=1.e5
     132          phis(:)=0.
    113133c---------------------------------------------------------------------
    114134
    115         taurappel=10.*daysec
     135          taurappel=10.*daysec
    116136
    117137c---------------------------------------------------------------------
    … …  
    119139c   --------------------------------------
    120140
    121         DO l=1,llm
    122          zsig=ap(l)/preff+bp(l)
    123          if (zsig.gt.0.3) then
    124            lsup=l
    125            tetarappell=1./8.*(-log(zsig)-.5)
    126            DO j=1,jjp1
     141          DO l=1,llm
     142            zsig=ap(l)/preff+bp(l)
     143            if (zsig.gt.0.3) then
     144             lsup=l
     145             tetarappell=1./8.*(-log(zsig)-.5)
     146             DO j=1,jjp1
    127147             ddsin=sin(rlatu(j))-sin(pi/20.)
    128148             tetajl(j,l)=300.*(1+1./18.*(1.-3.*ddsin*ddsin)+tetarappell)
    129            ENDDO
    130           else
     149             ENDDO
     150            else
    131151c   Choix isotherme au-dessus de 300 mbar
    132            do j=1,jjp1
    133              tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
    134            enddo
    135           endif ! of if (zsig.gt.0.3)
    136         ENDDO ! of DO l=1,llm
    137 
    138         do l=1,llm
    139            do j=1,jjp1
     152             do j=1,jjp1
     153               tetajl(j,l)=tetajl(j,lsup)*(0.3/zsig)**kappa
     154             enddo
     155            endif ! of if (zsig.gt.0.3)
     156          ENDDO ! of DO l=1,llm
     157
     158          do l=1,llm
     159            do j=1,jjp1
    140160              do i=1,iip1
    141161                 ij=(j-1)*iip1+i
    142162                 tetarappel(ij,l)=tetajl(j,l)
    143163              enddo
    144            enddo
    145         enddo
     164            enddo
     165          enddo
    146166
    147167c       call dump2d(jjp1,llm,tetajl,'TEQ   ')
    148168
    149         ps=1.e5
    150         phis=0.
    151         CALL pression ( ip1jmp1, ap, bp, ps, p       )
    152         CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
    153         CALL massdair(p,masse)
     169          CALL pression ( ip1jmp1, ap, bp, ps, p       )
     170          CALL exner_hyb( ip1jmp1, ps, p,alpha,beta, pks, pk, pkf )
     171          CALL massdair(p,masse)
    154172
    155173c  intialisation du vent et de la temperature
    156         teta(:,:)=tetarappel(:,:)
    157         CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
    158         call ugeostr(phi,ucov)
    159         vcov=0.
    160         q(:,:,1   )=1.e-10
    161         q(:,:,2   )=1.e-15
    162         q(:,:,3:nqtot)=0.
     174          teta(:,:)=tetarappel(:,:)
     175          CALL geopot(ip1jmp1,teta,pk,pks,phis,phi)
     176          call ugeostr(phi,ucov)
     177          vcov=0.
     178          q(:,:,1   )=1.e-10
     179          q(:,:,2   )=1.e-15
     180          q(:,:,3:nqtot)=0.
    163181
    164182
    165183c   perturbation aleatoire sur la temperature
    166         idum  = -1
    167         zz = ran1(idum)
    168         idum  = 0
    169         do l=1,llm
    170            do ij=iip2,ip1jm
     184          idum  = -1
     185          zz = ran1(idum)
     186          idum  = 0
     187          do l=1,llm
     188            do ij=iip2,ip1jm
    171189              teta(ij,l)=teta(ij,l)*(1.+0.005*ran1(idum))
    172            enddo
    173         enddo
    174 
    175         do l=1,llm
    176            do ij=1,ip1jmp1,iip1
     190            enddo
     191          enddo
     192
     193          do l=1,llm
     194            do ij=1,ip1jmp1,iip1
    177195              teta(ij+iim,l)=teta(ij,l)
    178            enddo
    179         enddo
     196            enddo
     197          enddo
    180198
    181199
    … …  
    187205
    188206c   initialisation d'un traceur sur une colonne
    189         j=jjp1*3/4
    190         i=iip1/2
    191         ij=(j-1)*iip1+i
    192         q(ij,:,3)=1.
    193      
     207          j=jjp1*3/4
     208          i=iip1/2
     209          ij=(j-1)*iip1+i
     210          q(ij,:,3)=1.
     211        endif ! of if (iflag_phys.eq.2)
     212       
    194213      else
    195214        write(lunout,*)"iniacademic: planet types other than earth",

  • LMDZ5/trunk/libf/dyn3dmem/iniconst.F

    r1632 r1657  
    11!
    2 ! $Id: iniconst.F 1299 2010-01-20 14:27:21Z fairhead $
     2! $Id: iniconst.F 1380 2010-05-06 12:24:59Z emillour $
    33!
    44      SUBROUTINE iniconst
    55
    66      USE control_mod
     7
    78      IMPLICIT NONE
    89c
    … …  
    1819#include "temps.h"
    1920#include "comvert.h"
     21#include "iniprint.h"
    2022
    2123
    … …  
    5355      r       = cpp * kappa
    5456
    55       PRINT*,' R  CP  Kappa ',  r , cpp,  kappa
     57      write(lunout,*)'iniconst: R  CP  Kappa ',  r , cpp,  kappa
    5658c
    5759c-----------------------------------------------------------------------

  • LMDZ5/trunk/libf/dyn3dmem/inter_barxy_m.F90

    r1632 r1657  
    118118    IMPLICIT NONE
    119119
    120     REAL, intent(in):: dlonid(:)
    121     real, intent(in):: fdat(:)
    122     real, intent(in):: rlonimod(:)
     120    REAL, intent(in):: dlonid(:) ! dim(idatmax)
     121    real, intent(in):: fdat(:) ! dim(idatmax)
     122    real, intent(in):: rlonimod(:) ! dim(imodmax)
    123123
    124124    real inter_barx(size(rlonimod))
    … …  
    176176
    177177    DO idat = 1, idatmax
    178        xxd(idat) = AMOD( xxd(idat) - xim0, 360. )
     178       xxd(idat) = MOD( xxd(idat) - xim0, 360. )
    179179       fdd(idat) = fdat (idat)
    180180    ENDDO

  • LMDZ5/trunk/libf/dyn3dmem/leapfrog_loc.F

    r1632 r1657  
    7575#include "description.h"
    7676#include "serre.h"
    77 #include "com_io_dyn.h"
     77!#include "com_io_dyn.h"
    7878#include "iniprint.h"
    7979#include "academic.h"
    … …  
    397397
    398398      IF( purmats ) THEN
     399      ! Purely Matsuno time stepping
    399400         IF( MOD(itau,iconser) .EQ.0.AND.  forward    ) conser = .TRUE.
    400401         IF( MOD(itau,idissip ).EQ.0.AND..NOT.forward ) apdiss = .TRUE.
    … …  
    402403     s          .and. iflag_phys.EQ.1                 ) apphys = .TRUE.
    403404      ELSE
     405      ! Leapfrog/Matsuno time stepping
    404406         IF( MOD(itau   ,iconser) .EQ. 0              ) conser = .TRUE.
    405407         IF( MOD(itau+1,idissip)  .EQ. 0              ) apdiss = .TRUE.
    … …  
    407409      END IF
    408410
     411! Ehouarn: for Shallow Water case (ie: 1 vertical layer),
     412!          supress dissipation step
     413      if (llm.eq.1) then
     414        apdiss=.false.
     415      endif
     416
    409417cym    ---> Pour le moment     
    410418cym      apphys = .FALSE.
    411419      statcl = .FALSE.
    412       conser = .FALSE.
     420      conser = .FALSE. ! ie: no output of control variables to stdout in //
    413421     
    414422      if (firstCaldyn) then
    … …  
    10691077       ijb=ij_begin
    10701078       ije=ij_end
    1071        teta(ijb:ije,:)=teta(ijb:ije,:)
    1072      s  -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
     1079!LF       teta(ijb:ije,:)=teta(ijb:ije,:)
     1080!LF     s  -iphysiq*dtvr*(teta(ijb:ije,:)-tetarappel(ijb:ije,:))/taurappel
     1081!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     1082       do l=1,llm
     1083       teta(ijb:ije,l)=teta(ijb:ije,l)
     1084     &  -iphysiq*dtvr*(teta(ijb:ije,l)-tetarappel(ijb:ije,l))/taurappel
     1085       enddo
     1086!$OMP END DO
    10731087
    10741088       call Register_Hallo_u(ucov,llm,0,1,1,0,Request_Physic)
    … …  
    10771091c$OMP BARRIER
    10781092       call WaitRequest(Request_Physic)     
    1079 
     1093c$OMP BARRIER
    10801094       call friction_loc(ucov,vcov,iphysiq*dtvr)
     1095!$OMP BARRIER
    10811096      ENDIF ! of IF(iflag_phys.EQ.2)
    10821097
    … …  
    13121327!c$OMP END MASTER
    13131328!c$OMP BARRIER
    1314        END IF
     1329       END IF ! of IF(apdiss)
    13151330
    13161331cc$OMP END PARALLEL
Note: See TracChangeset for help on using the changeset viewer.