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

Encapsulate files in modules

Location:
LMDZ6/branches/Amaury_dev/libf/dyn3d_common
Files:
1 edited
3 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3d_common/grilles_gcm_netcdf_sub.F90

    r5159 r5186  
    1717  USE lmdz_comgeom
    1818
    19 USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19  USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    2020  USE lmdz_paramet
     21  USE lmdz_conf_gcm, ONLY: conf_gcm
     22
    2123  IMPLICIT NONE
    22 
    23 
    2424
    2525

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

    r5185 r5186  
    1 ! $Header$
     1MODULE lmdz_covnat
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC covnat
    24
    3 SUBROUTINE covnat(klevel, ucov, vcov, unat, vnat)
    4   USE lmdz_comgeom
     5CONTAINS
    56
    6   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    7   USE lmdz_paramet
    8   IMPLICIT NONE
     7  SUBROUTINE covnat(klevel, ucov, vcov, unat, vnat)
     8    USE lmdz_comgeom
    99
    10   !=======================================================================
     10    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     11    USE lmdz_paramet
     12    IMPLICIT NONE
    1113
    12   !   Auteur:  F Hourdin Phu LeVan
    13   !   -------
     14    !=======================================================================
    1415
    15   !   Objet:
    16   !   ------
     16    !   Auteur:  F Hourdin Phu LeVan
     17    !   -------
    1718
    18   !  *********************************************************************
    19   !    calcul des compos. naturelles a partir des comp.covariantes
    20   !  ********************************************************************
     19    !   Objet:
     20    !   ------
    2121
    22   !=======================================================================
     22    !  *********************************************************************
     23    !    calcul des compos. naturelles a partir des comp.covariantes
     24    !  ********************************************************************
     25
     26    !=======================================================================
     27
     28    INTEGER :: klevel
     29    REAL :: ucov(ip1jmp1, klevel), vcov(ip1jm, klevel)
     30    REAL :: unat(ip1jmp1, klevel), vnat(ip1jm, klevel)
     31    INTEGER :: l, ij
     32
     33    DO l = 1, klevel
     34      DO ij = 1, iip1
     35        unat (ij, l) = 0.
     36      END DO
     37
     38      DO ij = iip2, ip1jm
     39        unat(ij, l) = ucov(ij, l) / cu(ij)
     40      ENDDO
     41      DO ij = ip1jm + 1, ip1jmp1
     42        unat (ij, l) = 0.
     43      END DO
     44
     45      DO ij = 1, ip1jm
     46        vnat(ij, l) = vcov(ij, l) / cv(ij)
     47      ENDDO
     48
     49    ENDDO
     50
     51  END SUBROUTINE covnat
    2352
    2453
    25 
    26 
    27   INTEGER :: klevel
    28   REAL :: ucov(ip1jmp1, klevel), vcov(ip1jm, klevel)
    29   REAL :: unat(ip1jmp1, klevel), vnat(ip1jm, klevel)
    30   INTEGER :: l, ij
    31 
    32   DO l = 1, klevel
    33     DO ij = 1, iip1
    34       unat (ij, l) = 0.
    35     END DO
    36 
    37     DO ij = iip2, ip1jm
    38       unat(ij, l) = ucov(ij, l) / cu(ij)
    39     ENDDO
    40     DO ij = ip1jm + 1, ip1jmp1
    41       unat (ij, l) = 0.
    42     END DO
    43 
    44     DO ij = 1, ip1jm
    45       vnat(ij, l) = vcov(ij, l) / cv(ij)
    46     ENDDO
    47 
    48   ENDDO
    49 
    50 END SUBROUTINE covnat
     54END MODULE lmdz_covnat

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

    r5185 r5186  
    1 ! $Id$
     1MODULE lmdz_writedynav
     2  IMPLICIT NONE; PRIVATE
     3  PUBLIC writedynav
    24
    3 SUBROUTINE writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
     5CONTAINS
    46
    5   USE ioipsl
    6   USE lmdz_infotrac, ONLY: nqtot
    7   USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
    8   USE comconst_mod, ONLY: cpp
    9   USE temps_mod, ONLY: itau_dyn
    10   USE lmdz_description, ONLY: descript
    11   USE lmdz_iniprint, ONLY: lunout, prt_level
    12   USE lmdz_comgeom
     7  SUBROUTINE writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
    138
    14   USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
    15   USE lmdz_paramet
    16   IMPLICIT NONE
     9    USE ioipsl
     10    USE lmdz_infotrac, ONLY: nqtot
     11    USE com_io_dyn_mod, ONLY: histaveid, histvaveid, histuaveid
     12    USE comconst_mod, ONLY: cpp
     13    USE temps_mod, ONLY: itau_dyn
     14    USE lmdz_description, ONLY: descript
     15    USE lmdz_iniprint, ONLY: lunout, prt_level
     16    USE lmdz_comgeom
    1717
    18   !   Ecriture du fichier histoire au format IOIPSL
     18    USE lmdz_dimensions, ONLY: iim, jjm, llm, ndm
     19    USE lmdz_paramet
     20    USE lmdz_covnat, ONLY: covnat
    1921
    20   !   Appels succesifs des routines: histwrite
     22    IMPLICIT NONE
    2123
    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
     24    !   Ecriture du fichier histoire au format IOIPSL
    3225
    33   !   L. Fairhead, LMD, 03/99
     26    !   Appels succesifs des routines: histwrite
    3427
    35   !   Arguments
     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
    3638
    37   REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
    38   REAL teta(ip1jmp1 * llm), phi(ip1jmp1, llm), ppk(ip1jmp1 * llm)
    39   REAL ps(ip1jmp1), masse(ip1jmp1, llm)
    40   REAL phis(ip1jmp1)
    41   REAL q(ip1jmp1, llm, nqtot)
    42   INTEGER time
     39    !   L. Fairhead, LMD, 03/99
    4340
    44   ! This routine needs IOIPSL to work
    45   !   Variables locales
     41    !   Arguments
    4642
    47   INTEGER ndex2d(ip1jmp1), ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm)
    48   INTEGER iq, ii, ll
    49   REAL tm(ip1jmp1 * llm)
    50   REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
    51   LOGICAL ok_sync
    52   INTEGER itau_w
     43    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
     44    REAL teta(ip1jmp1 * llm), phi(ip1jmp1, llm), ppk(ip1jmp1 * llm)
     45    REAL ps(ip1jmp1), masse(ip1jmp1, llm)
     46    REAL phis(ip1jmp1)
     47    REAL q(ip1jmp1, llm, nqtot)
     48    INTEGER time
    5349
    54   !-----------------------------------------------------------------
     50    ! This routine needs IOIPSL to work
     51    !   Variables locales
    5552
    56   !  Initialisations
     53    INTEGER ndex2d(ip1jmp1), ndexu(ip1jmp1 * llm), ndexv(ip1jm * llm)
     54    INTEGER iq, ii, ll
     55    REAL tm(ip1jmp1 * llm)
     56    REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
     57    LOGICAL ok_sync
     58    INTEGER itau_w
    5759
    58   ndexu = 0
    59   ndexv = 0
    60   ndex2d = 0
    61   ok_sync = .TRUE.
    62   tm = 999.999
    63   vnat = 999.999
    64   unat = 999.999
    65   itau_w = itau_dyn + time
     60    !-----------------------------------------------------------------
    6661
    67   ! Passage aux composantes naturelles du vent
    68   CALL covnat(llm, ucov, vcov, unat, vnat)
     62    !  Initialisations
    6963
    70   !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     64    ndexu = 0
     65    ndexv = 0
     66    ndex2d = 0
     67    ok_sync = .TRUE.
     68    tm = 999.999
     69    vnat = 999.999
     70    unat = 999.999
     71    itau_w = itau_dyn + time
    7172
    72   !  Vents U
     73    ! Passage aux composantes naturelles du vent
     74    CALL covnat(llm, ucov, vcov, unat, vnat)
    7375
    74   CALL histwrite(histuaveid, 'u', itau_w, unat, &
    75           iip1 * jjp1 * llm, ndexu)
     76    !  Appels a histwrite pour l'ecriture des variables a sauvegarder
    7677
    77   !  Vents V
     78    !  Vents U
    7879
    79   CALL histwrite(histvaveid, 'v', itau_w, vnat, &
    80           iip1 * jjm * llm, ndexv)
     80    CALL histwrite(histuaveid, 'u', itau_w, unat, &
     81            iip1 * jjp1 * llm, ndexu)
    8182
    82   !  Temperature potentielle moyennee
     83    !  Vents V
    8384
    84   CALL histwrite(histaveid, 'theta', itau_w, teta, &
    85           iip1 * jjp1 * llm, ndexu)
     85    CALL histwrite(histvaveid, 'v', itau_w, vnat, &
     86            iip1 * jjm * llm, ndexv)
    8687
    87   !  Temperature moyennee
     88    !  Temperature potentielle moyennee
    8889
    89   DO ii = 1, ijp1llm
    90     tm(ii) = teta(ii) * ppk(ii) / cpp
    91   enddo
    92   CALL histwrite(histaveid, 'temp', itau_w, tm, &
    93           iip1 * jjp1 * llm, ndexu)
     90    CALL histwrite(histaveid, 'theta', itau_w, teta, &
     91            iip1 * jjp1 * llm, ndexu)
    9492
    95   !  Geopotentiel
     93    !  Temperature moyennee
    9694
    97   CALL histwrite(histaveid, 'phi', itau_w, phi, &
    98           iip1 * jjp1 * llm, ndexu)
     95    DO ii = 1, ijp1llm
     96      tm(ii) = teta(ii) * ppk(ii) / cpp
     97    enddo
     98    CALL histwrite(histaveid, 'temp', itau_w, tm, &
     99            iip1 * jjp1 * llm, ndexu)
    99100
    100   !  Traceurs
     101    !  Geopotentiel
    101102
    102   !  DO iq=1, nqtot
    103   !       CALL histwrite(histaveid, tracers(iq)%longName, itau_w, &
    104   !                   q(:, :, iq), iip1*jjp1*llm, ndexu)
    105   ! enddo
     103    CALL histwrite(histaveid, 'phi', itau_w, phi, &
     104            iip1 * jjp1 * llm, ndexu)
    106105
    107   !  Masse
     106    !  Traceurs
    108107
    109   CALL histwrite(histaveid, 'masse', itau_w, masse, &
    110           iip1 * jjp1 * llm, ndexu)
     108    !  DO iq=1, nqtot
     109    !       CALL histwrite(histaveid, tracers(iq)%longName, itau_w, &
     110    !                   q(:, :, iq), iip1*jjp1*llm, ndexu)
     111    ! enddo
    111112
    112   !  Pression au sol
     113    !  Masse
    113114
    114   CALL histwrite(histaveid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)
     115    CALL histwrite(histaveid, 'masse', itau_w, masse, &
     116            iip1 * jjp1 * llm, ndexu)
    115117
    116   ! Geopotentiel au sol
     118    !  Pression au sol
    117119
    118   ! CALL histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     120    CALL histwrite(histaveid, 'ps', itau_w, ps, iip1 * jjp1, ndex2d)
    119121
    120   IF (ok_sync) THEN
    121     CALL histsync(histaveid)
    122     CALL histsync(histvaveid)
    123     CALL histsync(histuaveid)
    124   ENDIF
     122    ! Geopotentiel au sol
    125123
    126 END SUBROUTINE  writedynav
     124    ! CALL histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     125
     126    IF (ok_sync) THEN
     127      CALL histsync(histaveid)
     128      CALL histsync(histvaveid)
     129      CALL histsync(histuaveid)
     130    ENDIF
     131
     132  END SUBROUTINE  writedynav
     133
     134
     135END MODULE lmdz_writedynav

  • 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.