Ignore:
Timestamp:
Jul 26, 2024, 7:20:23 PM (11 months ago)
Author:
abarral
Message:

Put iotd* into lmdz_iotd.f90

Location:
LMDZ6/branches/Amaury_dev/libf/phylmd
Files:
3 deleted
18 edited
2 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxqfi2.f90

    r5117 r5135  
    66  INCLUDE "dimensions.h"
    77
    8   ! character*20 comment
     8  ! CHARACTER*20 comment
    99  CHARACTER(LEN = *) :: comment
    1010  REAL :: qmin, qmax

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/minmaxsource.f90

    r5117 r5135  
    77  INCLUDE "dimensions.h"
    88
    9   ! character*20 comment
     9  ! CHARACTER*20 comment
    1010  CHARACTER(LEN = *) :: comment
    1111  REAL :: qmin, qmax

  • LMDZ6/branches/Amaury_dev/libf/phylmd/Dust/read_surface.F90

    r5117 r5135  
    1515       INCLUDE "paramet.h"
    1616
    17        character*10 name
    18        character*10 varname
     17       CHARACTER*10 name
     18       CHARACTER*10 varname
    1919
    2020       REAL tmp_dyn(iip1,jjp1)
    … …  
    3232       INTEGER start(2),count(2),status
    3333       INTEGER i,j,l,ig
    34        character*1 str1
     34       CHARACTER*1 str1
    3535
    3636!JE20140526<<
    37       character*4 ::  latstr,aux4s
     37      CHARACTER*4 ::  latstr,aux4s
    3838      LOGICAL :: outcycle, isinversed
    3939      REAL, DIMENSION(jjp1) :: lats

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/1D_decl_cases.h

    r5128 r5135  
    11
    22! Declarations specifiques au cas Toga
    3         character*80 :: fich_toga
     3        CHARACTER*80 :: fich_toga
    44!        integer nlev_prof
    55!        parameter (nlev_prof = 41)
    … …  
    4242!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4343! Declarations specifiques au cas RICO
    44         character*80 :: fich_rico
     44        CHARACTER*80 :: fich_rico
    4545        INTEGER nlev_rico
    4646
    … …  
    5454!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5555! Declarations specifiques au cas TWPice
    56         character*80 :: fich_twpice
     56        CHARACTER*80 :: fich_twpice
    5757        INTEGER nlev_twpi, nt_twpi
    5858        parameter (nlev_twpi=40, nt_twpi=215)
    … …  
    8484
    8585!Declarations specifiques au cas FIRE
    86         character*80 :: fich_fire
     86        CHARACTER*80 :: fich_fire
    8787        INTEGER nlev_fire, nt_fire
    8888        parameter (nlev_fire=120, nt_fire=1) 
    … …  
    9797!Declarations specifiques au cas GABLS4   (MPL 20141023)
    9898!FHADETRUIRE
    99 !       character*80 :: fich_gabls4
     99!       CHARACTER*80 :: fich_gabls4
    100100!       integer nlev_gabls4, nt_gabls4, nsol_gabls4
    101101!       parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19) 
    … …  
    132132
    133133!Declarations specifiques au cas DICE     (MPL 02072013)
    134         character*80 :: fich_dice
     134        CHARACTER*80 :: fich_dice
    135135        INTEGER nlev_dice, nt_dice
    136136        parameter (nlev_dice=70, nt_dice=145) 
    … …  
    178178!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    179179! Declarations specifiques au cas GCSSold
    180         character*80 :: fich_gcssold_ctl
    181         character*80 :: fich_gcssold_dat
     180        CHARACTER*80 :: fich_gcssold_ctl
     181        CHARACTER*80 :: fich_gcssold_dat
    182182        real  ht_gcssold(llm),hq_gcssold(llm),hw_gcssold(llm)
    183183        real  hu_gcssold(llm)
    … …  
    193193!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    194194! Declarations specifiques au cas Arm_cu
    195         character*80 :: fich_armcu
     195        CHARACTER*80 :: fich_armcu
    196196
    197197
    … …  
    218218!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    219219! declarations specifiques au cas Sandu
    220         character*80 :: fich_sandu
     220        CHARACTER*80 :: fich_sandu
    221221!        integer nlev_prof
    222222!        parameter (nlev_prof = 41)
    … …  
    256256!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    257257! Declarations specifiques au cas Astex
    258         character*80 :: fich_astex
     258        CHARACTER*80 :: fich_astex
    259259        INTEGER nlev_astex, nt_astex
    260260        parameter (nlev_astex=34, nt_astex=49)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/fcg_racmo.h

    r5117 r5135  
    55      LOGICAL :: ok_invertp
    66      INTEGER :: forc_trb
    7       character*31 :: fich_racmo
     7      CHARACTER*31 :: fich_racmo
    88
    99      common /fcg_racmo/forc_trb,ok_invertp,a_guide,fich_racmo

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_1dutils.f90

    r5134 r5135  
    742742    PARAMETER (length = 100)
    743743    REAL tab_cntrl(length) ! tableau des parametres du run
    744     character*4 nmq(nqtot)
    745     character*12 modname
    746     character*80 abort_message
     744    CHARACTER*4 nmq(nqtot)
     745    CHARACTER*12 modname
     746    CHARACTER*80 abort_message
    747747    LOGICAL found
    748748
    … …  
    878878    PARAMETER (length = 100)
    879879    REAL tab_cntrl(length) ! tableau des parametres du run
    880     character*4 nmq(nqtot)
    881     character*20 modname
    882     character*80 abort_message
     880    CHARACTER*4 nmq(nqtot)
     881    CHARACTER*20 modname
     882    CHARACTER*80 abort_message
    883883
    884884    INTEGER pass

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_comdissnew.f90

    r5134 r5135  
    1 link ../../dyn3d_common/comdissnew.h
     1link ../../dyn3d_common/lmdz_comdissnew.f90

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/lmdz_old_1dconv.f90

    r5134 r5135  
    115115    save timeaft, timebef
    116116    INTEGER temps
    117     character*4 string
     117    CHARACTER*4 string
    118118    !----------------------------------------------------------------------
    119119    ! variables arguments de la subroutine rdgrads
    … …  
    142142    ! variables destinees a la lecture du pas de temps du fichier de donnees
    143143    !---------------------------------------------------------------------
    144     character*80 aaa, atemps, apasmax
     144    CHARACTER*80 aaa, atemps, apasmax
    145145    INTEGER nch, imn, ipa
    146146    !---------------------------------------------------------------------
    … …  
    509509    REAL playgcm(klevgcm) ! pression en milieu de couche du gcm
    510510    REAL psolgcm
    511     character*80 file_forctl
     511    CHARACTER*80 file_forctl
    512512
    513513    klev = klevgcm
    … …  
    577577    INTEGER i, lu, mlz, mlzh
    578578
    579     character*80 file_forctl
    580 
    581     character*4 a
    582     character*80 aaa, anblvl
     579    CHARACTER*80 file_forctl
     580
     581    CHARACTER*4 a
     582    CHARACTER*80 aaa, anblvl
    583583    INTEGER nch
    584584

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_amma_read.F90

    r5117 r5135  
    44!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    55!Declarations specifiques au cas AMMA
    6         character*80 :: fich_amma
     6        CHARACTER*80 :: fich_amma
    77! Option du cas AMMA ou on impose la discretisation verticale (Ap,Bp)
    88        INTEGER nlev_amma, nt_amma

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read.F90

    r5117 r5135  
    55!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    66!Declarations specifiques au cas standard
    7         character*80 :: fich_cas
     7        CHARACTER*80 :: fich_cas
    88! Discr?tisation
    99        INTEGER nlev_cas, nt_cas

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read2.F90

    r5117 r5135  
    77!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    88  !Declarations specifiques au cas standard
    9   character*80 :: fich_cas
     9  CHARACTER*80 :: fich_cas
    1010  ! Discr?tisation
    1111  INTEGER nlev_cas, nt_cas
    … …  
    563563  parameter(nbvar3d=39)
    564564  INTEGER var3didin(nbvar3d)
    565   character*5 name_var(1:nbvar3d)
     565  CHARACTER*5 name_var(1:nbvar3d)
    566566  data name_var/'zz','pp','temp','qv','rh','theta','rv','u','v','ug','vg','w','advu','hu','vu',&
    567567       'advv','hv','vv','advT','hT','vT','advq','hq','vq','advth','hth','vth','advr','hr','vr',&
    … …  
    680680  parameter(nbvar3d=62)
    681681  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    682   character*12 name_var(1:nbvar3d)
     682  CHARACTER*12 name_var(1:nbvar3d)
    683683  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    684684       'w','omega','ug','vg','uadv','uadvh','uadvv','vadv','vadvh','vadvv','tadv','tadvh','tadvv',&
    … …  
    852852  parameter(nbvar3d=70)
    853853  INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    854   character*13 name_var(1:nbvar3d)
     854  CHARACTER*13 name_var(1:nbvar3d)
    855855  data name_var/'coor_par_a','coor_par_b','height_h','pressure_h',&
    856856       'temp','qv','ql','qi','u','v','tke','pressure',&

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/mod_1D_cases_read_std.F90

    r5117 r5135  
    88!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    99  !Declarations specifiques au cas standard
    10   character*80 :: fich_cas
     10  CHARACTER*80 :: fich_cas
    1111  ! Discr?tisation
    1212  INTEGER nlev_cas, nt_cas
    … …  
    365365    parameter(nbvar3d=78)
    366366    INTEGER var3didin(nbvar3d),missing_var(nbvar3d)
    367     character*13 name_var(1:nbvar3d)
     367    CHARACTER*13 name_var(1:nbvar3d)
    368368
    369369

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1DUTILS_read_interp.h

    r5119 r5135  
    1616      REAL ht_toga(nlev_toga,nt_toga),vt_toga(nlev_toga,nt_toga)
    1717      REAL hq_toga(nlev_toga,nt_toga),vq_toga(nlev_toga,nt_toga)
    18       character*80 fich_toga
     18      CHARACTER*80 fich_toga
    1919
    2020      INTEGER k,ip
    … …  
    7373      INTEGER nlev_sandu,nt_sandu
    7474      REAL ts_sandu(nt_sandu)
    75       character*80 fich_sandu
     75      CHARACTER*80 fich_sandu
    7676
    7777      INTEGER ip
    … …  
    111111      REAL div_astex(nt_astex),ts_astex(nt_astex),ug_astex(nt_astex)
    112112      REAL vg_astex(nt_astex),ufa_astex(nt_astex),vfa_astex(nt_astex)
    113       character*80 fich_astex
     113      CHARACTER*80 fich_astex
    114114
    115115      INTEGER ip
    … …  
    154154      INTEGER ntime,nlevel
    155155      INTEGER l,k
    156       character*80 :: fich_twpice
     156      CHARACTER*80 :: fich_twpice
    157157      real*8 time(ntime)
    158158      real*8 lat, lon, alt, phis
    … …  
    794794      REAL prico(nlev_rico),zrico(nlev_rico)
    795795
    796       character*80 fich_rico
     796      CHARACTER*80 fich_rico
    797797
    798798      INTEGER k,l
    … …  
    10191019      REAL sens(nt_armcu),flat(nt_armcu)
    10201020      REAL adv_theta(nt_armcu),rad_theta(nt_armcu),adv_qt(nt_armcu)
    1021       character*80 fich_armcu
     1021      CHARACTER*80 fich_armcu
    10221022
    10231023      INTEGER ip
    … …  
    21642164
    21652165      INTEGER ntime,nlevel
    2166       character*80 :: fich_fire
     2166      CHARACTER*80 :: fich_fire
    21672167      real*8 zz(nlevel)
    21682168
    … …  
    23782378      INTEGER ntime,nlevel
    23792379      INTEGER l,k
    2380       character*80 :: fich_dice
     2380      CHARACTER*80 :: fich_dice
    23812381      real*8 time(ntime)
    23822382      real*8 zz(nlevel)
    … …  
    27102710      INTEGER ntime,nlevel,nsol
    27112711      INTEGER l,k
    2712       character*80 :: fich_gabls4
     2712      CHARACTER*80 :: fich_gabls4
    27132713      real*8 time(ntime)
    27142714

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/old_1D_decl_cases.h

    r5117 r5135  
    11
    22! Declarations specifiques au cas Toga
    3         character*80 :: fich_toga
     3        CHARACTER*80 :: fich_toga
    44!        integer nlev_prof
    55!        parameter (nlev_prof = 41)
    … …  
    4040!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    4141! Declarations specifiques au cas RICO
    42         character*80 :: fich_rico
     42        CHARACTER*80 :: fich_rico
    4343        INTEGER nlev_rico
    4444
    … …  
    5252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    5353! Declarations specifiques au cas TWPice
    54         character*80 :: fich_twpice
     54        CHARACTER*80 :: fich_twpice
    5555        INTEGER nlev_twpi, nt_twpi
    5656        parameter (nlev_twpi=40, nt_twpi=215)
    … …  
    8282
    8383!Declarations specifiques au cas FIRE
    84         character*80 :: fich_fire
     84        CHARACTER*80 :: fich_fire
    8585        INTEGER nlev_fire, nt_fire
    8686        parameter (nlev_fire=120, nt_fire=1) 
    … …  
    9494!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    9595!Declarations specifiques au cas GABLS4   (MPL 20141023)
    96         character*80 :: fich_gabls4
     96        CHARACTER*80 :: fich_gabls4
    9797        INTEGER nlev_gabls4, nt_gabls4, nsol_gabls4
    9898        parameter (nlev_gabls4=90, nt_gabls4=37, nsol_gabls4=19) 
    … …  
    128128
    129129!Declarations specifiques au cas DICE     (MPL 02072013)
    130         character*80 :: fich_dice
     130        CHARACTER*80 :: fich_dice
    131131        INTEGER nlev_dice, nt_dice
    132132        parameter (nlev_dice=70, nt_dice=145) 
    … …  
    174174!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    175175! Declarations specifiques au cas GCSSold
    176         character*80 :: fich_gcssold_ctl
    177         character*80 :: fich_gcssold_dat
     176        CHARACTER*80 :: fich_gcssold_ctl
     177        CHARACTER*80 :: fich_gcssold_dat
    178178        real  ht_gcssold(llm),hq_gcssold(llm),hw_gcssold(llm)
    179179        real  hu_gcssold(llm)
    … …  
    189189!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    190190! Declarations specifiques au cas Arm_cu
    191         character*80 :: fich_armcu
     191        CHARACTER*80 :: fich_armcu
    192192
    193193
    … …  
    214214!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    215215! declarations specifiques au cas Sandu
    216         character*80 :: fich_sandu
     216        CHARACTER*80 :: fich_sandu
    217217!        integer nlev_prof
    218218!        parameter (nlev_prof = 41)
    … …  
    252252!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    253253! Declarations specifiques au cas Astex
    254         character*80 :: fich_astex
     254        CHARACTER*80 :: fich_astex
    255255        INTEGER nlev_astex, nt_astex
    256256        parameter (nlev_astex=34, nt_astex=49)

  • LMDZ6/branches/Amaury_dev/libf/phylmd/dyn1d/replay1d.F90

    r5128 r5135  
    66  USE comvert_mod, ONLY: preff, pa
    77  USE ioipsl, ONLY: getin
     8  USE lmdz_iotd, ONLY: iotd_ini
    89
    910  IMPLICIT NONE

  • LMDZ6/branches/Amaury_dev/libf/phylmd/ener_conserv.F90

    r5134 r5135  
    5656REAL ZRCPD
    5757
    58 character*80 abort_message
    59 character*20 :: modname
     58CHARACTER*80 abort_message
     59CHARACTER*20 :: modname
    6060
    6161

  • LMDZ6/branches/Amaury_dev/libf/phylmd/iophys.F90

    r5134 r5135  
    44!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    55
    6       SUBROUTINE iophys_ecrit(nom,lllm,titre,unite,px)
    7 
    8       USE lmdz_phys_para, ONLY: klon_omp, is_mpi_root
    9       USE lmdz_phys_transfert_para, ONLY: gather
    10       USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo
    11       IMPLICIT NONE
    12 
    13 
    14 
    15 !  Ecriture de variables diagnostiques au choix dans la physique
    16 !  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
    17 !  3d (ex : temperature), 2d (ex : temperature de surface), ou
    18 !  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
    19 !  solaire)
    20 !  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
    21 !  La periode d'ecriture est donnee par
    22 !  "ecritphy " regle dans le fichier de controle de run :  run.def
    23 
    24 !    writediagfi peut etre appele de n'importe quelle subroutine
    25 !    de la physique, plusieurs fois. L'initialisation et la creation du
    26 !    fichier se fait au tout premier appel.
    27 
    28 ! WARNING : les variables dynamique (u,v,t,q,ps)
    29 !  sauvees par writediagfi avec une
    30 ! date donnee sont legerement differentes que dans le fichier histoire car
    31 ! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
    32 ! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
    33 ! avant l'ecriture dans diagfi (cf. physiq.F)
    34 
    35 ! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
    36 
    37 !  parametres (input) :
    38 !  ----------
    39 !      unit : unite logique du fichier de sortie (toujours la meme)
    40 !      nom  : nom de la variable a sortir (chaine de caracteres)
    41 !      titre: titre de la variable (chaine de caracteres)
    42 !      unite : unite de la variable (chaine de caracteres)
    43 !      px : variable a sortir (real 0, 1, 2, ou 3d)
    44 
    45 !=================================================================
    46 
    47 
    48 ! Arguments on input:
    49       INTEGER lllm
    50       CHARACTER (LEN=*) :: nom,titre,unite
    51       INTEGER imjmax
    52       parameter (imjmax=100000)
    53       REAL px(klon_omp,lllm)
    54       REAL xglo(klon_glo,lllm)
    55       REAL zx(nbp_lon,nbp_lat,lllm)
    56 
    57 
    58 
    59       CALL Gather(px,xglo)
    60 !$OMP MASTER
    61       IF (is_mpi_root) THEN       
    62         CALL Grid1Dto2D_glo(xglo,zx)
    63         CALL iotd_ecrit(nom,lllm,titre,unite,zx)
    64       ENDIF
    65 !$OMP END MASTER
    66 
    67       RETURN
    68       end
     6SUBROUTINE iophys_ecrit(nom, lllm, titre, unite, px)
     7
     8  USE lmdz_phys_para, ONLY: klon_omp, is_mpi_root
     9  USE lmdz_phys_transfert_para, ONLY: gather
     10  USE lmdz_grid_phy, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dto2d_glo
     11  USE lmdz_iotd, ONLY: iotd_ecrit
     12
     13
     14  IMPLICIT NONE
     15
     16
     17
     18  !  Ecriture de variables diagnostiques au choix dans la physique
     19  !  dans un fichier NetCDF nomme  'diagfi'. Ces variables peuvent etre
     20  !  3d (ex : temperature), 2d (ex : temperature de surface), ou
     21  !  0d (pour un scalaire qui ne depend que du temps : ex : la longitude
     22  !  solaire)
     23  !  (ou encore 1d, dans le cas de testphys1d, pour sortir une colonne)
     24  !  La periode d'ecriture est donnee par
     25  !  "ecritphy " regle dans le fichier de controle de run :  run.def
     26
     27  !    writediagfi peut etre appele de n'importe quelle subroutine
     28  !    de la physique, plusieurs fois. L'initialisation et la creation du
     29  !    fichier se fait au tout premier appel.
     30
     31  ! WARNING : les variables dynamique (u,v,t,q,ps)
     32  !  sauvees par writediagfi avec une
     33  ! date donnee sont legerement differentes que dans le fichier histoire car
     34  ! on ne leur a pas encore ajoute de la dissipation et de la physique !!!
     35  ! IL est  RECOMMANDE d'ajouter les tendance physique a ces variables
     36  ! avant l'ecriture dans diagfi (cf. physiq.F)
     37
     38  ! Modifs: Aug.2010 Ehouarn: enforce outputs to be real*4
     39
     40  !  parametres (input) :
     41  !  ----------
     42  !      unit : unite logique du fichier de sortie (toujours la meme)
     43  !      nom  : nom de la variable a sortir (chaine de caracteres)
     44  !      titre: titre de la variable (chaine de caracteres)
     45  !      unite : unite de la variable (chaine de caracteres)
     46  !      px : variable a sortir (real 0, 1, 2, ou 3d)
     47
     48  !=================================================================
     49
     50
     51  ! Arguments on input:
     52  INTEGER lllm
     53  CHARACTER (LEN = *) :: nom, titre, unite
     54  INTEGER imjmax
     55  parameter (imjmax = 100000)
     56  REAL px(klon_omp, lllm)
     57  REAL xglo(klon_glo, lllm)
     58  REAL zx(nbp_lon, nbp_lat, lllm)
     59
     60  CALL Gather(px, xglo)
     61  !$OMP MASTER
     62  IF (is_mpi_root) THEN
     63    CALL Grid1Dto2D_glo(xglo, zx)
     64    CALL iotd_ecrit(nom, lllm, titre, unite, zx)
     65  ENDIF
     66  !$OMP END MASTER
     67
     68  RETURN
     69end
    6970
    7071!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    … …  
    7475
    7576
    76     SUBROUTINE iophys_ecrit_index(nom,lllm,titre,unite,knon,knindex,px)
    77 
    78     USE lmdz_phys_para, ONLY: klon_omp
    79     USE dimphy, ONLY: klon
    80     USE lmdz_grid_phy, ONLY: klon_glo
    81     USE lmdz_abort_physic, ONLY: abort_physic
    82     IMPLICIT NONE
    83 
    84 ! This SUBROUTINE returns the sea surface temperature already read from limit.nc
    85 
    86 ! Arguments on input:
    87     INTEGER lllm
    88     CHARACTER (len=*) :: nom,titre,unite
    89     REAL px(klon_omp,lllm)
    90     INTEGER, INTENT(IN)                  :: knon     ! nomber of points on compressed grid
    91     INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
    92     REAL, DIMENSION(klon,lllm) :: varout
    93 
    94     INTEGER :: i,l
    95 
    96     IF (klon/=klon_omp) THEN
    97       PRINT*,'klon, klon_omp',klon,klon_omp
    98       CALL abort_physic('iophys_ecrit','probleme de dimension parallele',1)
     77SUBROUTINE iophys_ecrit_index(nom, lllm, titre, unite, knon, knindex, px)
     78
     79  USE lmdz_phys_para, ONLY: klon_omp
     80  USE dimphy, ONLY: klon
     81  USE lmdz_grid_phy, ONLY: klon_glo
     82  USE lmdz_abort_physic, ONLY: abort_physic
     83  IMPLICIT NONE
     84
     85  ! This SUBROUTINE returns the sea surface temperature already read from limit.nc
     86
     87  ! Arguments on input:
     88  INTEGER lllm
     89  CHARACTER (len = *) :: nom, titre, unite
     90  REAL px(klon_omp, lllm)
     91  INTEGER, INTENT(IN) :: knon     ! nomber of points on compressed grid
     92  INTEGER, DIMENSION(klon), INTENT(IN) :: knindex  ! grid point number for compressed grid
     93  REAL, DIMENSION(klon, lllm) :: varout
     94
     95  INTEGER :: i, l
     96
     97  IF (klon/=klon_omp) THEN
     98    PRINT*, 'klon, klon_omp', klon, klon_omp
     99    CALL abort_physic('iophys_ecrit', 'probleme de dimension parallele', 1)
     100  ENDIF
     101
     102  varout(1:klon, 1:lllm) = 0.
     103  DO l = 1, lllm
     104    DO i = 1, knon
     105      varout(knindex(i), l) = px(i, l)
     106    END DO
     107  END DO
     108  CALL iophys_ecrit(nom, lllm, titre, unite, varout)
     109
     110END SUBROUTINE iophys_ecrit_index
     111
     112!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     113SUBROUTINE iophys_ini(timestep)
     114  USE lmdz_phys_para, ONLY: is_mpi_root
     115  USE lmdz_vertical_layers, ONLY: presnivs
     116  USE lmdz_regular_lonlat, ONLY: lon_reg, lat_reg
     117  USE dimphy, ONLY: klev
     118  USE lmdz_grid_phy, ONLY: klon_glo
     119  USE time_phylmdz_mod, ONLY: annee_ref, day_ref, day_ini
     120  USE phys_cal_mod, ONLY: calend
     121  USE lmdz_iotd, ONLY: iotd_ini
     122
     123  IMPLICIT NONE
     124
     125  include "YOMCST.h"
     126  !=======================================================================
     127
     128  !   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
     129  !   -------
     130
     131  !   Objet:
     132  !   ------
     133
     134  !   'Initialize' the diagfi.nc file: write down dimensions as well
     135  !   as time-independent fields (e.g: geopotential, mesh area, ...)
     136
     137  !=======================================================================
     138  !-----------------------------------------------------------------------
     139  !   Declarations:
     140  !   -------------
     141
     142  REAL pi
     143  INTEGER nlat_eff
     144  INTEGER jour0, mois0, an0
     145  REAL timestep, t0
     146  CHARACTER(len = 20) :: calendrier
     147
     148  !   Arguments:
     149  !   ----------
     150
     151
     152  !$OMP MASTER
     153  IF (is_mpi_root) THEN
     154
     155    ! Bidouille pour gerer le fait que lat_reg contient deux latitudes
     156    ! en version uni-dimensionnelle (chose qui pourrait être résolue
     157    ! par ailleurs)
     158    IF (klon_glo==1) THEN
     159      nlat_eff = 1
     160    ELSE
     161      nlat_eff = size(lat_reg)
    99162    ENDIF
    100 
    101     varout(1:klon,1:lllm)=0.
    102     DO l = 1, lllm
    103     DO i = 1, knon
    104        varout(knindex(i),l) = px(i,l)
    105     END DO
    106     END DO
    107     CALL iophys_ecrit(nom,lllm,titre,unite,varout)
    108 
    109   END SUBROUTINE iophys_ecrit_index
    110 
    111 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    112       SUBROUTINE iophys_ini(timestep)
    113       USE lmdz_phys_para, ONLY: is_mpi_root
    114       USE lmdz_vertical_layers, ONLY: presnivs
    115       USE lmdz_regular_lonlat, ONLY: lon_reg, lat_reg
    116       USE dimphy, ONLY: klev
    117       USE lmdz_grid_phy, ONLY: klon_glo
    118       USE time_phylmdz_mod, ONLY: annee_ref, day_ref, day_ini
    119       USE phys_cal_mod, ONLY: calend
    120 
    121       IMPLICIT NONE
    122 
    123       include "YOMCST.h"
    124 !=======================================================================
    125 
    126 !   Auteur:  L. Fairhead  ,  P. Le Van, Y. Wanherdrick, F. Forget
    127 !   -------
    128 
    129 !   Objet:
    130 !   ------
    131 
    132 !   'Initialize' the diagfi.nc file: write down dimensions as well
    133 !   as time-independent fields (e.g: geopotential, mesh area, ...)
    134 
    135 !=======================================================================
    136 !-----------------------------------------------------------------------
    137 !   Declarations:
    138 !   -------------
    139 
    140 REAL pi
    141 INTEGER nlat_eff
    142 INTEGER jour0,mois0,an0
    143 REAL timestep,t0
    144 CHARACTER(len=20) :: calendrier
    145 
    146 !   Arguments:
    147 !   ----------
    148 
    149 
    150 !$OMP MASTER
    151     IF (is_mpi_root) THEN       
    152 
    153 ! Bidouille pour gerer le fait que lat_reg contient deux latitudes
    154 ! en version uni-dimensionnelle (chose qui pourrait être résolue
    155 ! par ailleurs)
    156 IF (klon_glo==1) THEN
    157    nlat_eff=1
    158 ELSE
    159    nlat_eff=size(lat_reg)
    160 ENDIF
    161 pi=2.*asin(1.)
    162 
    163 ! PRINT*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref
    164 ! PRINT*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend
    165 
    166 ! Attention : les lignes ci dessous supposent un calendrier en 360 jours
    167 ! Pourrait être retravaillé
    168 
    169 jour0=day_ref-30*(day_ref/30)
    170 mois0=day_ref/30+1
    171 an0=annee_ref
    172 !FH BIZARE QUAND 1D ...  t0=(day_ini-1)*RDAY
    173 t0=0.
    174 calendrier=calend
    175 IF ( calendrier == "earth_360d" ) calendrier="360_day"
    176 
    177 PRINT*,'iophys_ini annee_ref day_ref',annee_ref,day_ref,day_ini,calend,t0
    178 
    179 
    180 CALL iotd_ini('phys.nc', &
    181 size(lon_reg),nlat_eff,klev,lon_reg(:)*180./pi,lat_reg*180./pi,presnivs,jour0,mois0,an0,t0,timestep,calendrier)
    182     ENDIF
    183 !$OMP END MASTER
    184 
    185       END
     163    pi = 2. * asin(1.)
     164
     165    ! PRINT*,'day_ini,annee_ref,day_ref',day_ini,annee_ref,day_ref
     166    ! PRINT*,'jD_ref,jH_ref,start_time, calend',jD_ref,jH_ref,start_time, calend
     167
     168    ! Attention : les lignes ci dessous supposent un calendrier en 360 jours
     169    ! Pourrait être retravaillé
     170
     171    jour0 = day_ref - 30 * (day_ref / 30)
     172    mois0 = day_ref / 30 + 1
     173    an0 = annee_ref
     174    !FH BIZARE QUAND 1D ...  t0=(day_ini-1)*RDAY
     175    t0 = 0.
     176    calendrier = calend
     177    IF (calendrier == "earth_360d") calendrier = "360_day"
     178
     179    PRINT*, 'iophys_ini annee_ref day_ref', annee_ref, day_ref, day_ini, calend, t0
     180
     181    CALL iotd_ini('phys.nc', &
     182            size(lon_reg), nlat_eff, klev, lon_reg(:) * 180. / pi, lat_reg * 180. / pi, presnivs, jour0, mois0, an0, t0, timestep, calendrier)
     183  ENDIF
     184  !$OMP END MASTER
     185
     186END
    186187
    187188#ifdef und
    … …  
    214215!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    215216
    216       SUBROUTINE iotd_ecrit_seq(nom,lllm,titre,unite,px)
    217 
    218       IMPLICIT NONE
    219 
    220 ! px arrive
    221 
    222       INCLUDE "iotd.h"
    223 
    224 
    225 ! Arguments on input:
    226       INTEGER lllm
    227       CHARACTER (LEN=*) :: nom,titre,unite
    228       INTEGER imjmax
    229       parameter (imjmax=100000)
    230       REAL px(imjmax*lllm)
    231       REAL, ALLOCATABLE :: zx(:,:,:)
    232       INTEGER i,j,l,ijl
    233 
    234       allocate(zx(imax,jmax,lllm))
    235 
    236       ijl=0
    237       do l=1,lllm
    238          ! Pole nord
    239          ijl=ijl+1
    240          do i=1,imax
    241             zx(i,1,l)=px(ijl)
    242          enddo
    243          ! Grille normale
    244          do j=2,jmax-1
    245             do i=1,imax
    246                ijl=ijl+1
    247                zx(i,j,l)=px(ijl)
    248             enddo
    249          enddo
    250          ! Pole sud
    251          IF ( jmax > 1 ) THEN
    252             ijl=ijl+1
    253             do i=1,imax
    254                zx(i,jmax,l)=px(ijl)
    255             enddo
    256          endif
     217SUBROUTINE iotd_ecrit_seq(nom, lllm, titre, unite, px)
     218  USE lmdz_iotd, ONLY: iotd_ecrit, imax, jmax
     219
     220  IMPLICIT NONE
     221
     222  ! Arguments on input:
     223  INTEGER lllm
     224  CHARACTER (LEN = *) :: nom, titre, unite
     225  INTEGER imjmax
     226  parameter (imjmax = 100000)
     227  REAL px(imjmax * lllm)
     228  REAL, ALLOCATABLE :: zx(:, :, :)
     229  INTEGER i, j, l, ijl
     230
     231  allocate(zx(imax, jmax, lllm))
     232
     233  ijl = 0
     234  do l = 1, lllm
     235    ! Pole nord
     236    ijl = ijl + 1
     237    do i = 1, imax
     238      zx(i, 1, l) = px(ijl)
     239    enddo
     240    ! Grille normale
     241    do j = 2, jmax - 1
     242      do i = 1, imax
     243        ijl = ijl + 1
     244        zx(i, j, l) = px(ijl)
    257245      enddo
    258 
    259       CALL iotd_ecrit(nom,lllm,titre,unite,zx)
    260       deallocate(zx)
    261 
    262       RETURN
    263       END
    264 
     246    enddo
     247    ! Pole sud
     248    IF (jmax > 1) THEN
     249      ijl = ijl + 1
     250      do i = 1, imax
     251        zx(i, jmax, l) = px(ijl)
     252      enddo
     253    endif
     254  enddo
     255
     256  CALL iotd_ecrit(nom, lllm, titre, unite, zx)
     257  deallocate(zx)
     258
     259  RETURN
     260END
     261

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_iotd.f90

    r5131 r5135  
    1010!=======================================================================
    1111
    12       INTEGER imax,jmax,lmax,nid
    13       INTEGER dim_coord(4)
    14       REAL iotd_ts,iotd_t0
    15       INTEGER :: n_names_iotd_def
    16       character*20, DIMENSION(200) :: names_iotd_def
    17       character*20 :: un_nom
    18 
    19       common/iotd_ca/imax,jmax,lmax,nid,dim_coord,iotd_t0,iotd_ts
    20       common/iotd_cb/n_names_iotd_def,names_iotd_def
    21 !$OMP THREADPRIVATE(/iotd_ca/)
    22 !$OMP THREADPRIVATE(/iotd_cb/)
     12MODULE lmdz_iotd
     13  IMPLICIT NONE; PRIVATE
     14  PUBLIC iotd_fin, iotd_ecrit, iotd_ini, imax, jmax
     15
     16  INTEGER imax, jmax, lmax, nid
     17  INTEGER dim_coord(4)
     18  REAL iotd_ts, iotd_t0
     19  INTEGER :: n_names_iotd_def
     20  CHARACTER*20, DIMENSION(200) :: names_iotd_def
     21  CHARACTER*20 :: un_nom
     22
     23  !$OMP THREADPRIVATE(imax, jmax, lmax, nid, dim_coord, iotd_t0, iotd_ts)
     24  !$OMP THREADPRIVATE(n_names_iotd_def, names_iotd_def)
     25CONTAINS
     26  SUBROUTINE iotd_fin
     27    USE netcdf, ONLY: nf90_close
     28    IMPLICIT NONE
     29    INTEGER ierr
     30
     31    ierr = nf90_close(nid)
     32  END SUBROUTINE iotd_fin
     33
     34  SUBROUTINE iotd_ecrit(nom, llm, titre, unite, px)
     35    !-----------------------------------------------------------------------
     36    !  ----------
     37    !      nom  : nom de la variable a sortir (chaine de caracteres)
     38    !      llm  : nombre de couches
     39    !      titre: titre de la variable (chaine de caracteres)
     40    !      unite : unite de la variable (chaine de caracteres)
     41    !      px : variable a sortir
     42    !=================================================================
     43
     44    USE netcdf, ONLY: nf90_put_var, nf90_inq_varid, nf90_enddef, nf90_redef, nf90_sync, nf90_noerr, &
     45            nf90_float, nf90_def_var
     46    IMPLICIT NONE
     47
     48    ! Arguments on input:
     49    INTEGER llm
     50    CHARACTER (LEN = *) :: nom, titre, unite
     51    INTEGER imjmax
     52    parameter (imjmax = 100000)
     53    REAL px(imjmax * llm)
     54
     55    ! Local variables:
     56
     57    real(kind = 4) date
     58    real(kind = 4) zx(imjmax * llm)
     59
     60    INTEGER ierr, ndim, dim_cc(4)
     61    INTEGER iq
     62    INTEGER i, j, l
     63
     64    INTEGER zitau
     65    CHARACTER firstnom*20
     66    SAVE firstnom
     67    SAVE zitau
     68    SAVE date
     69    DATA firstnom /'1234567890'/
     70    DATA zitau /0/
     71
     72    ! Ajouts
     73    INTEGER, save :: ntime = 0
     74    INTEGER :: idim, varid
     75    CHARACTER (LEN = 50) :: fichnom
     76    INTEGER, DIMENSION(4) :: id
     77    INTEGER, DIMENSION(4) :: edges, corner
     78
     79    IF (n_names_iotd_def>0 .and..not.any(names_iotd_def==nom)) RETURN
     80    !***************************************************************
     81    ! Initialisation of 'firstnom' and create/open the "diagfi.nc" NetCDF file
     82    ! ------------------------------------------------------------------------
     83    ! (Au tout premier appel de la SUBROUTINE durant le run.)
     84
     85
     86    !--------------------------------------------------------
     87    ! Write the variables to output file if it's time to do so
     88    !--------------------------------------------------------
     89
     90
     91    ! Compute/write/extend 'time' coordinate (date given in days)
     92    ! (done every "first call" (at given time level) to writediagfi)
     93    ! Note: date is incremented as 1 step ahead of physics time
     94    !--------------------------------------------------------
     95
     96    zx(1:imax * jmax * llm) = px(1:imax * jmax * llm)
     97    IF (firstnom =='1234567890') THEN
     98      firstnom = nom
     99    endif
     100
     101    !PRINT*,'nom ',nom,firstnom
     102
     103    !! Quand on tombe sur la premiere variable on ajoute un pas de temps
     104    IF (nom==firstnom) THEN
     105      ! We have identified a "first call" (at given date)
     106
     107      ntime = ntime + 1 ! increment # of stored time steps
     108
     109      !!          PRINT*,'ntime ',ntime
     110      date = iotd_t0 + ntime * iotd_ts
     111      !PRINT*,'iotd_ecrit ',iotd_ts,ntime, date
     112      !          date= float (zitau +1)/float (day_step)
     113
     114      ! compute corresponding date (in days and fractions thereof)
     115      ! Get NetCDF ID of 'time' variable
     116
     117      ierr = nf90_sync(nid)
     118
     119      ierr = nf90_inq_varid(nid, "time", varid)
     120      ! Write (append) the new date to the 'time' array
     121
     122      ierr = nf90_put_var(nid, varid, date, [ntime])
     123
     124      !          PRINT*,'date ',date,ierr,nid
     125      !        PRINT*,'IOTD Date ,varid,nid,ntime,date',varid,nid,ntime,date
     126
     127      IF (ierr/=nf90_noerr) THEN
     128        WRITE(*, *) "***** PUT_VAR matter in writediagfi_nc"
     129        WRITE(*, *) "***** with time"
     130        WRITE(*, *) 'ierr=', ierr
     131      endif
     132
     133      !          WRITE(6,*)'WRITEDIAGFI: date= ', date
     134    end if ! of if (nom.EQ.firstnom)
     135
     136
     137    !Case of a 3D variable
     138    !---------------------
     139    IF (llm==lmax) THEN
     140      ndim = 4
     141      corner(1) = 1
     142      corner(2) = 1
     143      corner(3) = 1
     144      corner(4) = ntime
     145      edges(1) = imax
     146      edges(2) = jmax
     147      edges(3) = llm
     148      edges(4) = 1
     149      dim_cc = dim_coord
     150
     151
     152      !Case of a 2D variable
     153      !---------------------
     154
     155    ELSE IF (llm==1) THEN
     156      ndim = 3
     157      corner(1) = 1
     158      corner(2) = 1
     159      corner(3) = ntime
     160      corner(4) = 1
     161      edges(1) = imax
     162      edges(2) = jmax
     163      edges(3) = 1
     164      edges(4) = 1
     165      dim_cc(1:2) = dim_coord(1:2)
     166      dim_cc(3) = dim_coord(4)
     167
     168    END IF ! of if llm=1 ou llm
     169
     170    ! AU premier pas de temps, on crée les variables
     171    !-----------------------------------------------
     172
     173    IF (ntime==1) THEN
     174      ierr = nf90_redef (nid)
     175      ierr = nf90_def_var(nid, nom, nf90_float, dim_cc, varid)
     176      !PRINT*,'DEF ',nom,nid,varid
     177      ierr = nf90_enddef(nid)
     178    ELSE
     179      ierr = nf90_inq_varid(nid, nom, varid)
     180      !PRINT*,'INQ ',nom,nid,varid
     181      ! Commandes pour recuperer automatiquement les coordonnees
     182      !             ierr= nf90_inq_dimid(nid,"longitude",id(1))
     183    END IF
     184
     185    ierr = nf90_put_var(nid, varid, zx, corner, edges)
     186
     187    IF (ierr/=nf90_noerr) THEN
     188      WRITE(*, *) "***** PUT_VAR problem in writediagfi"
     189      WRITE(*, *) "***** with ", nom
     190      WRITE(*, *) 'ierr=', ierr
     191    endif
     192
     193  END
     194
     195  SUBROUTINE iotd_ini(fichnom, iim, jjm, llm, prlon, prlat, pcoordv, jour0, mois0, an0, t0, timestep, calendrier)
     196    USE netcdf, ONLY: nf90_enddef, nf90_put_att, nf90_float, nf90_def_var, nf90_redef, &
     197            nf90_global, nf90_def_dim, nf90_create, nf90_clobber, nf90_unlimited, nf90_put_var
     198    IMPLICIT NONE
     199
     200    INTEGER iim, jjm, llm
     201    REAL prlon(iim), prlat(jjm), pcoordv(llm), timestep, t0
     202    INTEGER id_FOCE
     203    INTEGER jour0, mois0, an0
     204    CHARACTER*(*) calendrier
     205
     206    INTEGER corner(4), edges(4), ndim
     207    real  px(1000)
     208    CHARACTER (LEN = 10) :: nom
     209    real(kind = 4) rlon(iim), rlat(jjm), coordv(llm)
     210
     211    !   Local:
     212    !   ------
     213    CHARACTER*3, DIMENSION(12) :: cmois = (/'JAN', 'FEB', 'MAR', 'APR', 'MAY', 'JUN', 'JUL', 'AUG', 'SEP', 'OCT', 'NOV', 'DEC'/)
     214    CHARACTER*10 date0
     215    CHARACTER*11 date0b
     216
     217    INTEGER :: ierr
     218
     219    INTEGER :: nvarid
     220    INTEGER, DIMENSION(2) :: id
     221
     222    CHARACTER*(*) fichnom
     223
     224    REAL pi
     225
     226    iotd_ts = timestep
     227    iotd_t0 = t0
     228    PRINT*, 'iotd_ini, ', timestep, iotd_ts
     229    imax = iim
     230    jmax = jjm
     231    lmax = llm
     232    ! Utile pour passer en real*4 pour les ecritures
     233    rlon = prlon
     234    rlat = prlat
     235    coordv = pcoordv
     236
     237
     238    !-----------------------------------------------------------------------
     239    ! Possibilité de spécifier une liste de variables à sortir
     240    ! dans iotd.def
     241    ! Si iotd.def existe et est non vide,
     242    ! seules les variables faisant à la fois l'objet d'un CALL iotd_ecrit
     243    ! et étant spécifiées dans iotd.def sont sorties.
     244    ! Sinon, toutes les variables faisant l'objet d'un CALL iotd_ecrit
     245    ! sont sorties
     246    !-----------------------------------------------------------------------
     247    n_names_iotd_def = 0
     248    open(99, file = 'iotd.def', form = 'formatted', status = 'old', iostat = ierr)
     249    IF (ierr==0) THEN
     250      ierr = 0
     251      do while (ierr==0)
     252        read(99, *, iostat = ierr) un_nom
     253        IF (ierr==0) THEN
     254          n_names_iotd_def = n_names_iotd_def + 1
     255          names_iotd_def(n_names_iotd_def) = un_nom
     256        endif
     257      enddo
     258    endif
     259    PRINT*, n_names_iotd_def, names_iotd_def(1:n_names_iotd_def)
     260    close(99)
     261
     262    pi = 2. * asin(1.)
     263
     264    ! Define dimensions
     265
     266    ! Create the NetCDF file
     267    ierr = nf90_create(fichnom, nf90_clobber, nid)
     268    ierr = nf90_def_dim(nid, "lon", iim, dim_coord(1))
     269    ierr = nf90_def_dim(nid, "lat", jjm, dim_coord(2))
     270    ierr = nf90_def_dim(nid, "lev", llm, dim_coord(3))
     271    ierr = nf90_def_dim(nid, "time", nf90_unlimited, dim_coord(4))
     272    ierr = nf90_put_att(nid, nf90_global, 'Conventions', "CF-1.1")
     273    !ierr = nf90_put_att(nid,nf90_global,'file_name',TRIM(fname))
     274    ierr = nf90_enddef(nid)
     275
     276    ! Switch out of NetCDF Define mode
     277
     278    ierr = nf90_enddef(nid)
     279
     280    !  Contol parameters for this run
     281    ! ---- longitude -----------
     282
     283    ierr = nf90_redef(nid)
     284    ierr = nf90_def_var(nid, "lon", nf90_float, dim_coord(1), nvarid)
     285    ierr = nf90_put_att(nid, nvarid, 'axis', 'X')
     286    ierr = nf90_put_att(nid, nvarid, 'units', "degrees_east")
     287    ierr = nf90_enddef(nid)
     288    ierr = nf90_put_var(nid, nvarid, rlon)
     289    PRINT*, ierr
     290
     291    ! ---- latitude ------------
     292    ierr = nf90_redef(nid)
     293    ierr = nf90_def_var(nid, "lat", nf90_float, dim_coord(2), nvarid)
     294    ierr = nf90_put_att(nid, nvarid, 'axis', 'Y')
     295    ierr = nf90_put_att(nid, nvarid, 'units', "degrees_north")
     296    ierr = nf90_enddef(nid)
     297    ierr = nf90_put_var(nid, nvarid, rlat)
     298
     299    ! ---- vertical ------------
     300    ierr = nf90_redef(nid)
     301    ierr = nf90_def_var(nid, "lev", nf90_float, dim_coord(3), nvarid)
     302    ierr = nf90_put_att(nid, nvarid, "long_name", "vert level")
     303    IF (coordv(2)>coordv(1)) THEN
     304      ierr = nf90_put_att(nid, nvarid, "long_name", "pseudo-alt")
     305      ierr = nf90_put_att(nid, nvarid, 'positive', "up")
     306    else
     307      ierr = nf90_put_att(nid, nvarid, "long_name", "pressure")
     308      ierr = nf90_put_att(nid, nvarid, 'positive', "down")
     309    endif
     310    ierr = nf90_enddef(nid)
     311    ierr = nf90_put_var(nid, nvarid, coordv)
     312
     313    ! ---- time ----------------
     314    ierr = nf90_redef(nid)
     315    ! Define the 'time' variable
     316    ierr = nf90_def_var(nid, "time", nf90_float, dim_coord(4), nvarid)
     317    !     ! Add attributes
     318    ierr = nf90_put_att(nid, nvarid, 'axis', 'T')
     319    ierr = nf90_put_att(nid, nvarid, 'standard_name', 'time')
     320    WRITE(date0, '(i4.4,"-",i2.2,"-",i2.2)') an0, mois0, jour0
     321    ierr = nf90_put_att(nid, nvarid, 'units', &
     322            "seconds since " // date0 // " 00:00:00")
     323    ierr = nf90_put_att(nid, nvarid, 'calendar', calendrier)
     324    !ierr = nf90_put_att(nid,nvarid,'calendar','360d')
     325    ierr = nf90_put_att(nid, nvarid, 'title', 'Time')
     326    ierr = nf90_put_att(nid, nvarid, 'long_name', 'Time axis')
     327    WRITE(date0b, '(i4.4,"-",a3,"-",i2.2)') an0, cmois(mois0), jour0
     328    ierr = nf90_put_att(nid, nvarid, 'time_origin', &
     329            date0b // ' 00:00:00')
     330    ierr = nf90_enddef(nid)
     331
     332  END
     333
     334END MODULE lmdz_iotd

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_simu_airs.f90

    r5128 r5135  
    10861086
    10871087    REAL, INTENT(IN) :: x, bsup, binf
    1088     character*14, INTENT(IN) :: sx
     1088    CHARACTER*14, INTENT(IN) :: sx
    10891089    CHARACTER (len = 50) :: modname = 'simu_airs.test_bornes'
    10901090    CHARACTER (len = 160) :: abort_message

  • LMDZ6/branches/Amaury_dev/libf/phylmd/lmdz_thermcell_main.F90

    r5123 r5135  
    827827    INTEGER, INTENT(IN), DIMENSION(ngrid) :: long
    828828    REAL seuil
    829     character*21 comment
     829    CHARACTER*21 comment
    830830
    831831    seuil = 0.25
Note: See TracChangeset for help on using the changeset viewer.