Ignore:
Timestamp:
Sep 11, 2024, 6:03:07 PM (2 months ago)
Author:
abarral
Message:

Encapsulate files in modules

File:
1 moved

Legend:

Unmodified
Added
Removed

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

    r5185 r5186  
    1 ! $Id$
     1MODULE lmdz_writehist
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC writehist
    24
    3 SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis)
     5CONTAINS
    46
    5   USE ioipsl
    6   USE lmdz_infotrac, ONLY: nqtot
    7   USE com_io_dyn_mod, ONLY: histid, histvid, histuid
    8   USE temps_mod, ONLY: itau_dyn
    9   USE lmdz_description, ONLY: descript
    10   USE lmdz_iniprint, ONLY: lunout, prt_level
    11   USE lmdz_comgeom
     7  SUBROUTINE writehist(time, vcov, ucov, teta, phi, q, masse, ps, phis)
    128
    13   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    14   USE lmdz_paramet
    15   IMPLICIT NONE
     9    USE ioipsl
     10    USE lmdz_infotrac, ONLY: nqtot
     11    USE com_io_dyn_mod, ONLY: histid, histvid, histuid
     12    USE temps_mod, ONLY: itau_dyn
     13    USE lmdz_description, ONLY: descript
     14    USE lmdz_iniprint, ONLY: lunout, prt_level
     15    USE lmdz_comgeom
     16
     17    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     18    USE lmdz_paramet
     19    USE lmdz_covnat, ONLY: covnat
     20
     21    IMPLICIT NONE
    1622
    1723
    18   !   Ecriture du fichier histoire au format IOIPSL
     24    !   Ecriture du fichier histoire au format IOIPSL
    1925
    20   !   Appels succesifs des routines: histwrite
     26    !   Appels succesifs des routines: histwrite
    2127
    22   !   Entree:
    23   !  time: temps de l'ecriture
    24   !  vcov: vents v covariants
    25   !  ucov: vents u covariants
    26   !  teta: temperature potentielle
    27   !  phi : geopotentiel instantane
    28   !  q   : traceurs
    29   !  masse: masse
    30   !  ps   :pression au sol
    31   !  phis : geopotentiel au sol
     28    !   Entree:
     29    !  time: temps de l'ecriture
     30    !  vcov: vents v covariants
     31    !  ucov: vents u covariants
     32    !  teta: temperature potentielle
     33    !  phi : geopotentiel instantane
     34    !  q   : traceurs
     35    !  masse: masse
     36    !  ps   :pression au sol
     37    !  phis : geopotentiel au sol
    3238
    3339
    34   !   L. Fairhead, LMD, 03/99
     40    !   L. Fairhead, LMD, 03/99
    3541
    36   ! =====================================================================
     42    ! =====================================================================
    3743
    38   !   Declarations
     44    !   Declarations
    3945
    4046
    4147
    4248
    43   !   Arguments
    44   !
     49    !   Arguments
     50    !
    4551
    46   REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
    47   REAL :: teta(ip1jmp1, llm), phi(ip1jmp1, llm)
    48   REAL :: ps(ip1jmp1), masse(ip1jmp1, llm)
    49   REAL :: phis(ip1jmp1)
    50   REAL :: q(ip1jmp1, llm, nqtot)
    51   INTEGER :: time
     52    REAL :: vcov(ip1jm, llm), ucov(ip1jmp1, llm)
     53    REAL :: teta(ip1jmp1, llm), phi(ip1jmp1, llm)
     54    REAL :: ps(ip1jmp1), masse(ip1jmp1, llm)
     55    REAL :: phis(ip1jmp1)
     56    REAL :: q(ip1jmp1, llm, nqtot)
     57    INTEGER :: time
    5258
    5359
    54   ! This routine needs IOIPSL to work
    55   !   Variables locales
     60    ! This routine needs IOIPSL to work
     61    !   Variables locales
    5662
    57   INTEGER :: iq, ii, ll
    58   INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
    59   LOGICAL :: ok_sync
    60   INTEGER :: itau_w
    61   REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)
     63    INTEGER :: iq, ii, ll
     64    INTEGER :: ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm), ndex2d(ip1jmp1)
     65    LOGICAL :: ok_sync
     66    INTEGER :: itau_w
     67    REAL :: vnat(ip1jm, llm), unat(ip1jmp1, llm)
    6268
    6369
    64   !  Initialisations
     70    !  Initialisations
    6571
    66   ndexu = 0
    67   ndexv = 0
    68   ndex2d = 0
    69   ok_sync = .TRUE.
    70   itau_w = itau_dyn + time
    71   !  Passage aux composantes naturelles du vent
    72   CALL covnat(llm, ucov, vcov, unat, vnat)
     72    ndexu = 0
     73    ndexv = 0
     74    ndex2d = 0
     75    ok_sync = .TRUE.
     76    itau_w = itau_dyn + time
     77    !  Passage aux composantes naturelles du vent
     78    CALL covnat(llm, ucov, vcov, unat, vnat)
    7379
    74   !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     80    !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    7581
    76   !  Vents U
     82    !  Vents U
    7783
    78   CALL histwrite(histuid, 'u', itau_w, unat, &
    79           iip1 * jjp1 * llm, ndexu)
     84    CALL histwrite(histuid, 'u', itau_w, unat, &
     85            iip1 * jjp1 * llm, ndexu)
    8086
    81   !  Vents V
     87    !  Vents V
    8288
    83   CALL histwrite(histvid, 'v', itau_w, vnat, &
    84           iip1 * jjm * llm, ndexv)
     89    CALL histwrite(histvid, 'v', itau_w, vnat, &
     90            iip1 * jjm * llm, ndexv)
    8591
    8692
    87   !  Temperature potentielle
     93    !  Temperature potentielle
    8894
    89   CALL histwrite(histid, 'teta', itau_w, teta, &
    90           iip1 * jjp1 * llm, ndexu)
     95    CALL histwrite(histid, 'teta', itau_w, teta, &
     96            iip1 * jjp1 * llm, ndexu)
    9197
    92   !  Geopotentiel
     98    !  Geopotentiel
    9399
    94   CALL histwrite(histid, 'phi', itau_w, phi, &
    95           iip1 * jjp1 * llm, ndexu)
     100    CALL histwrite(histid, 'phi', itau_w, phi, &
     101            iip1 * jjp1 * llm, ndexu)
    96102
    97   !  Traceurs
     103    !  Traceurs
    98104
    99   !    DO iq=1,nqtot
    100   !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
    101   ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
    102   !    enddo
    103   !C
    104   !  Masse
     105    !    DO iq=1,nqtot
     106    !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
     107    ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
     108    !    enddo
     109    !C
     110    !  Masse
    105111
    106   CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu)
     112    CALL histwrite(histid, 'masse', itau_w, masse, iip1 * jjp1 * llm, ndexu)
    107113
    108   !  Pression au sol
     114    !  Pression au sol
    109115
    110   CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)
     116    CALL histwrite(histid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)
    111117
    112   !  Geopotentiel au sol
     118    !  Geopotentiel au sol
    113119
    114   !  CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     120    !  CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    115121
    116   !  Fin
     122    !  Fin
    117123
    118   IF (ok_sync) THEN
    119     CALL histsync(histid)
    120     CALL histsync(histvid)
    121     CALL histsync(histuid)
    122   ENDIF
    123   RETURN
    124 END SUBROUTINE writehist
     124    IF (ok_sync) THEN
     125      CALL histsync(histid)
     126      CALL histsync(histvid)
     127      CALL histsync(histuid)
     128    ENDIF
     129    RETURN
     130  END SUBROUTINE writehist
     131
     132
     133END MODULE lmdz_writehist
Note: See TracChangeset for help on using the changeset viewer.