Ignore:
Timestamp:
Jul 23, 2024, 8:22:55 AM (2 months ago)
Author:
abarral
Message:

Handle DEBUG_IO in lmdz_cppkeys_wrapper.F90
Transform some files .F -> .[fF]90
[ne compile pas à cause de writefield_u non défini - en attente de réponse Laurent]

File:
1 moved

Legend:

Unmodified
Added
Removed

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

    r5100 r5101  
    1 
    21! $Id$
    32
    4       subroutine inithist(day0,anne0,tstep,t_ops,t_wrt)
     3subroutine inithist(day0, anne0, tstep, t_ops, t_wrt)
    54
    65#ifdef CPP_IOIPSL
    7        USE IOIPSL
     6   USE IOIPSL
    87#endif
    9        USE infotrac, ONLY : nqtot
    10        use com_io_dyn_mod, only : histid,histvid,histuid,               &
    11      &                        dynhist_file,dynhistv_file,dynhistu_file
    12        USE comconst_mod, ONLY: pi
    13        USE comvert_mod, ONLY: presnivs
    14        USE temps_mod, ONLY: itau_dyn
    15        
    16       implicit none
     8  USE infotrac, ONLY: nqtot
     9  use com_io_dyn_mod, ONLY: histid, histvid, histuid, &
     10          dynhist_file, dynhistv_file, dynhistu_file
     11  USE comconst_mod, ONLY: pi
     12  USE comvert_mod, ONLY: presnivs
     13  USE temps_mod, ONLY: itau_dyn
    1714
    18 C
    19 C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    20 C   au format IOIPSL
    21 C
    22 C   Appels succesifs des routines: histbeg
    23 C                                  histhori
    24 C                                  histver
    25 C                                  histdef
    26 C                                  histend
    27 C
    28 C   Entree:
    29 C
    30 C      infile: nom du fichier histoire a creer
    31 C      day0,anne0: date de reference
    32 C      tstep: duree du pas de temps en seconde
    33 C      t_ops: frequence de l'operation pour IOIPSL
    34 C      t_wrt: frequence d'ecriture sur le fichier
    35 C      nq: nombre de traceurs
    36 C
    37 C
    38 C   L. Fairhead, LMD, 03/99
    39 C
    40 C =====================================================================
    41 C
    42 C   Declarations
    43       include "dimensions.h"
    44       include "paramet.h"
    45       include "comgeom.h"
    46       include "description.h"
    47       include "iniprint.h"
     15  implicit none
    4816
    49 C   Arguments
    50 C
    51       integer day0, anne0
    52       real tstep, t_ops, t_wrt
     17  !
     18  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
     19  !   au format IOIPSL
     20  !
     21  !   Appels succesifs des routines: histbeg
     22  !                              histhori
     23  !                              histver
     24  !                              histdef
     25  !                              histend
     26  !
     27  !   Entree:
     28  !
     29  !  infile: nom du fichier histoire a creer
     30  !  day0,anne0: date de reference
     31  !  tstep: duree du pas de temps en seconde
     32  !  t_ops: frequence de l'operation pour IOIPSL
     33  !  t_wrt: frequence d'ecriture sur le fichier
     34  !  nq: nombre de traceurs
     35  !
     36  !
     37  !   L. Fairhead, LMD, 03/99
     38  !
     39  ! =====================================================================
     40  !
     41  !   Declarations
     42  include "dimensions.h"
     43  include "paramet.h"
     44  include "comgeom.h"
     45  include "description.h"
     46  include "iniprint.h"
     47
     48  !   Arguments
     49  !
     50  integer :: day0, anne0
     51  real :: tstep, t_ops, t_wrt
    5352
    5453#ifdef CPP_IOIPSL
    55 ! This routine needs IOIPSL to work
    56 C   Variables locales
    57 C
    58       integer tau0
    59       real zjulian
    60       integer iq
    61       real rlong(iip1,jjp1), rlat(iip1,jjp1)
    62       integer uhoriid, vhoriid, thoriid, zvertiid
    63       integer ii,jj
    64       integer zan, dayref
    65 C
    66 C  Initialisations
    67 C
    68       pi = 4. * atan (1.)
    69 C
    70 C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    71 C         
     54  ! This routine needs IOIPSL to work
     55  !   Variables locales
     56  !
     57  integer :: tau0
     58  real :: zjulian
     59  integer :: iq
     60  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
     61  integer :: uhoriid, vhoriid, thoriid, zvertiid
     62  integer :: ii,jj
     63  integer :: zan, dayref
     64  !
     65  !  Initialisations
     66  !
     67  pi = 4. * atan (1.)
     68  !
     69  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
     70  !
    7271
    73       zan = anne0
    74       dayref = day0
    75       CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
    76       tau0 = itau_dyn
    77      
    78 ! -------------------------------------------------------------
    79 ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
    80 ! -------------------------------------------------------------
    81 !Grille U     
    82       do jj = 1, jjp1
    83         do ii = 1, iip1
    84           rlong(ii,jj) = rlonu(ii) * 180. / pi
    85           rlat(ii,jj) = rlatu(jj) * 180. / pi
    86         enddo
    87       enddo
    88        
    89       call histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    90      .             1, iip1, 1, jjp1,
    91      .             tau0, zjulian, tstep, uhoriid, histuid)
     72  zan = anne0
     73  dayref = day0
     74  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
     75  tau0 = itau_dyn
    9276
    93 ! Grille V
    94       do jj = 1, jjm
    95         do ii = 1, iip1
    96           rlong(ii,jj) = rlonv(ii) * 180. / pi
    97           rlat(ii,jj) = rlatv(jj) * 180. / pi
    98         enddo
    99       enddo
     77  ! -------------------------------------------------------------
     78  ! Creation des 3 fichiers pour les grilles horizontales U,V,Scal
     79  ! -------------------------------------------------------------
     80  !Grille U
     81  do jj = 1, jjp1
     82    do ii = 1, iip1
     83      rlong(ii,jj) = rlonu(ii) * 180. / pi
     84      rlat(ii,jj) = rlatu(jj) * 180. / pi
     85    enddo
     86  enddo
    10087
    101       call histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:),
    102      .             1, iip1, 1, jjm,
    103      .             tau0, zjulian, tstep, vhoriid, histvid)
     88  CALL histbeg(dynhistu_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
     89        1, iip1, 1, jjp1, &
     90        tau0, zjulian, tstep, uhoriid, histuid)
    10491
    105 !Grille Scalaire
    106       do jj = 1, jjp1
    107         do ii = 1, iip1
    108           rlong(ii,jj) = rlonv(ii) * 180. / pi
    109           rlat(ii,jj) = rlatu(jj) * 180. / pi
    110         enddo
    111       enddo
     92  ! Grille V
     93  do jj = 1, jjm
     94    do ii = 1, iip1
     95      rlong(ii,jj) = rlonv(ii) * 180. / pi
     96      rlat(ii,jj) = rlatv(jj) * 180. / pi
     97    enddo
     98  enddo
    11299
    113       call histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:),
    114      .             1, iip1, 1, jjp1,
    115      .             tau0, zjulian, tstep, thoriid, histid)
    116 ! -------------------------------------------------------------
    117 C  Appel a histvert pour la grille verticale
    118 ! -------------------------------------------------------------
    119       call histvert(histid, 'presnivs', 'Niveaux pression','mb',
    120      .              llm, presnivs/100., zvertiid,'down')
    121       call histvert(histvid, 'presnivs', 'Niveaux pression','mb',
    122      .              llm, presnivs/100., zvertiid,'down')
    123       call histvert(histuid, 'presnivs', 'Niveaux pression','mb',
    124      .              llm, presnivs/100., zvertiid,'down')
    125 C
    126 ! -------------------------------------------------------------
    127 C  Appels a histdef pour la definition des variables a sauvegarder
    128 ! -------------------------------------------------------------
    129 C
    130 C  Vents U
    131 C
    132       call histdef(histuid, 'u', 'vent u', 'm/s',
    133      .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
    134      .             32, 'inst(X)', t_ops, t_wrt)
    135 C
    136 C  Vents V
    137 C
    138       call histdef(histvid, 'v', 'vent v', 'm/s',
    139      .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    140      .             32, 'inst(X)', t_ops, t_wrt)
     100  CALL histbeg(dynhistv_file, iip1, rlong(:,1), jjm, rlat(1,:), &
     101        1, iip1, 1, jjm, &
     102        tau0, zjulian, tstep, vhoriid, histvid)
    141103
    142 C
    143 C  Temperature potentielle
    144 C
    145       call histdef(histid, 'teta', 'temperature potentielle', '-',
    146      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    147      .             32, 'inst(X)', t_ops, t_wrt)
    148 C
    149 C  Geopotentiel
    150 C
    151       call histdef(histid, 'phi', 'geopotentiel', '-',
    152      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    153      .             32, 'inst(X)', t_ops, t_wrt)
    154 C
    155 C  Traceurs
    156 C
     104  !Grille Scalaire
     105  do jj = 1, jjp1
     106    do ii = 1, iip1
     107      rlong(ii,jj) = rlonv(ii) * 180. / pi
     108      rlat(ii,jj) = rlatu(jj) * 180. / pi
     109    enddo
     110  enddo
    157111
    158 !        DO iq=1,nqtot
    159 !          call histdef(histid, tracers(iq)%name,
    160 !                               tracers(iq)%longName, '-',
    161 !     .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    162 !     .             32, 'inst(X)', t_ops, t_wrt)
    163 !        enddo
    164 !C
    165 C  Masse
    166 C
    167       call histdef(histid, 'masse', 'masse', 'kg',
    168      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    169      .             32, 'inst(X)', t_ops, t_wrt)
    170 C
    171 C  Pression au sol
    172 C
    173       call histdef(histid, 'ps', 'pression naturelle au sol', 'Pa',
    174      .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    175      .             32, 'inst(X)', t_ops, t_wrt)
    176 C
    177 C  Geopotentiel au sol
    178 !C
    179 !      call histdef(histid, 'phis', 'geopotentiel au sol', '-',
    180 !     .             iip1, jjp1, thoriid, 1, 1, 1, -99,
    181 !     .             32, 'inst(X)', t_ops, t_wrt)
    182 !C
    183 C  Fin
    184 C
    185       call histend(histid)
    186       call histend(histuid)
    187       call histend(histvid)
     112  CALL histbeg(dynhist_file, iip1, rlong(:,1), jjp1, rlat(1,:), &
     113        1, iip1, 1, jjp1, &
     114        tau0, zjulian, tstep, thoriid, histid)
     115  ! -------------------------------------------------------------
     116  !  Appel a histvert pour la grille verticale
     117  ! -------------------------------------------------------------
     118  CALL histvert(histid, 'presnivs', 'Niveaux pression','mb', &
     119        llm, presnivs/100., zvertiid,'down')
     120  CALL histvert(histvid, 'presnivs', 'Niveaux pression','mb', &
     121        llm, presnivs/100., zvertiid,'down')
     122  CALL histvert(histuid, 'presnivs', 'Niveaux pression','mb', &
     123        llm, presnivs/100., zvertiid,'down')
     124  !
     125  ! -------------------------------------------------------------
     126  !  Appels a histdef pour la definition des variables a sauvegarder
     127  ! -------------------------------------------------------------
     128  !
     129  !  Vents U
     130  !
     131  CALL histdef(histuid, 'u', 'vent u', 'm/s', &
     132        iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
     133        32, 'inst(X)', t_ops, t_wrt)
     134  !
     135  !  Vents V
     136  !
     137  CALL histdef(histvid, 'v', 'vent v', 'm/s', &
     138        iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
     139        32, 'inst(X)', t_ops, t_wrt)
     140
     141  !
     142  !  Temperature potentielle
     143  !
     144  CALL histdef(histid, 'teta', 'temperature potentielle', '-', &
     145        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     146        32, 'inst(X)', t_ops, t_wrt)
     147  !
     148  !  Geopotentiel
     149  !
     150  CALL histdef(histid, 'phi', 'geopotentiel', '-', &
     151        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     152        32, 'inst(X)', t_ops, t_wrt)
     153  !
     154  !  Traceurs
     155  !
     156
     157  !    DO iq=1,nqtot
     158  !      CALL histdef(histid, tracers(iq)%name,
     159  !                           tracers(iq)%longName, '-',
     160  ! .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
     161  ! .             32, 'inst(X)', t_ops, t_wrt)
     162  !    enddo
     163  !C
     164  !  Masse
     165  !
     166  CALL histdef(histid, 'masse', 'masse', 'kg', &
     167        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     168        32, 'inst(X)', t_ops, t_wrt)
     169  !
     170  !  Pression au sol
     171  !
     172  CALL histdef(histid, 'ps', 'pression naturelle au sol', 'Pa', &
     173        iip1, jjp1, thoriid, 1, 1, 1, -99, &
     174        32, 'inst(X)', t_ops, t_wrt)
     175  !
     176  !  Geopotentiel au sol
     177  !C
     178  !  CALL histdef(histid, 'phis', 'geopotentiel au sol', '-',
     179  ! .             iip1, jjp1, thoriid, 1, 1, 1, -99,
     180  ! .             32, 'inst(X)', t_ops, t_wrt)
     181  !C
     182  !  Fin
     183  !
     184  CALL histend(histid)
     185  CALL histend(histuid)
     186  CALL histend(histvid)
    188187#else
    189 ! tell the user this routine should be run with ioipsl
    190       write(lunout,*)"inithist: Warning this routine should not be",
    191      &               " used without ioipsl"
     188  ! tell the user this routine should be run with ioipsl
     189  write(lunout, *)"inithist: Warning this routine should not be", &
     190          " used without ioipsl"
    192191#endif
    193 ! of #ifdef CPP_IOIPSL
    194       return
    195       end
     192  ! of #ifdef CPP_IOIPSL
     193  return
     194end subroutine inithist
Note: See TracChangeset for help on using the changeset viewer.