Ignore:
Timestamp:
Oct 21, 2024, 2:58:45 PM (23 hours ago)
Author:
abarral
Message:

Convert fixed-form to free-form sources .F -> .{f,F}90
(WIP: some .F remain, will be handled in subsequent commits)

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/initfluxsto.F90

    r5245 r5246  
    22! $Id$
    33!
    4       subroutine initfluxsto
    5      .  (infile,tstep,t_ops,t_wrt,
    6      .                    fileid,filevid,filedid)
     4subroutine initfluxsto &
     5        (infile,tstep,t_ops,t_wrt, &
     6        fileid,filevid,filedid)
    77
    88#ifdef CPP_IOIPSL
    9        USE IOIPSL
     9   USE IOIPSL
    1010#endif
    11       USE comconst_mod, ONLY: pi
    12       USE comvert_mod, ONLY: nivsigs
    13       USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
    14      
    15       implicit none
    16 
    17 C
    18 C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    19 C   au format IOIPSL
    20 C
    21 C   Appels succesifs des routines: histbeg
    22 C                                  histhori
    23 C                                  histver
    24 C                                  histdef
    25 C                                  histend
    26 C
    27 C   Entree:
    28 C
    29 C      infile: nom du fichier histoire a creer
    30 C      day0,anne0: date de reference
    31 C      tstep: duree du pas de temps en seconde
    32 C      t_ops: frequence de l'operation pour IOIPSL
    33 C      t_wrt: frequence d'ecriture sur le fichier
    34 C
    35 C   Sortie:
    36 C      fileid: ID du fichier netcdf cree
    37 C      filevid:ID du fichier netcdf pour la grille v
    38 C
    39 C   L. Fairhead, LMD, 03/99
    40 C
    41 C =====================================================================
    42 C
    43 C   Declarations
    44       include "dimensions.h"
    45       include "paramet.h"
    46       include "comgeom.h"
    47       include "description.h"
    48       include "iniprint.h"
    49 
    50 C   Arguments
    51 C
    52       character*(*) infile
    53       real tstep, t_ops, t_wrt
    54       integer fileid, filevid,filedid
     11  USE comconst_mod, ONLY: pi
     12  USE comvert_mod, ONLY: nivsigs
     13  USE temps_mod, ONLY: annee_ref, day_ref, itau_dyn
     14
     15  implicit none
     16
     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  !
     35  !   Sortie:
     36  !  fileid: ID du fichier netcdf cree
     37  !  filevid:ID du fichier netcdf pour la grille v
     38  !
     39  !   L. Fairhead, LMD, 03/99
     40  !
     41  ! =====================================================================
     42  !
     43  !   Declarations
     44  include "dimensions.h"
     45  include "paramet.h"
     46  include "comgeom.h"
     47  include "description.h"
     48  include "iniprint.h"
     49
     50  !   Arguments
     51  !
     52  character(len=*) :: infile
     53  real :: tstep, t_ops, t_wrt
     54  integer :: fileid, filevid,filedid
    5555
    5656#ifdef CPP_IOIPSL
    57 ! This routine needs IOIPSL to work
    58 C   Variables locales
    59 C
    60       real nivd(1)
    61       integer tau0
    62       real zjulian
    63       character*3 str
    64       character*10 ctrac
    65       integer iq
    66       real rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
    67       integer uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
    68       integer ii,jj
    69       integer zan, idayref
    70       logical ok_sync
    71 C
    72 C  Initialisations
    73 C
    74       pi = 4. * atan (1.)
    75       str='q  '
    76       ctrac = 'traceur   '
    77       ok_sync = .true.
    78 C
    79 C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    80 C         
    81 
    82       zan = annee_ref
    83       idayref = day_ref
    84       CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
    85       tau0 = itau_dyn
    86        
    87         do jj = 1, jjp1
    88         do ii = 1, iip1
    89           rlong(ii,jj) = rlonu(ii) * 180. / pi
    90           rlat(ii,jj) = rlatu(jj) * 180. / pi
    91         enddo
    92       enddo
    93  
    94       call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:),
    95      .             1, iip1, 1, jjp1,
    96      .             tau0, zjulian, tstep, uhoriid, fileid)
    97 C
    98 C  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
    99 C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
    100 C  un meme fichier)
    101 
    102 
    103       do jj = 1, jjm
    104         do ii = 1, iip1
    105           rlong(ii,jj) = rlonv(ii) * 180. / pi
    106           rlat(ii,jj) = rlatv(jj) * 180. / pi
    107         enddo
    108       enddo
    109 
    110       call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:),
    111      .             1, iip1, 1, jjm,
    112      .             tau0, zjulian, tstep, vhoriid, filevid)
    113        
    114         rl(1,1) = 1.
    115       call histbeg('defstoke.nc', 1, rl, 1, rl,
    116      .             1, 1, 1, 1,
    117      .             tau0, zjulian, tstep, dhoriid, filedid)
    118 
    119 C
    120 C  Appel a histhori pour rajouter les autres grilles horizontales
    121 C
    122       do jj = 1, jjp1
    123         do ii = 1, iip1
    124           rlong(ii,jj) = rlonv(ii) * 180. / pi
    125           rlat(ii,jj) = rlatu(jj) * 180. / pi
    126         enddo
    127       enddo
    128 
    129       call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar',
    130      .              'Grille points scalaires', thoriid)
    131        
    132 C
    133 C  Appel a histvert pour la grille verticale
    134 C
    135       call histvert(fileid, 'sig_s', 'Niveaux sigma',
    136      . 'sigma_level',
    137      .              llm, nivsigs, zvertiid)
    138 C Pour le fichier V
    139       call histvert(filevid, 'sig_s', 'Niveaux sigma',
    140      .  'sigma_level',
    141      .              llm, nivsigs, zvertiid)
    142 c pour le fichier def
    143       nivd(1) = 1
    144       call histvert(filedid, 'sig_s', 'Niveaux sigma',
    145      .  'sigma_level',
    146      .              1, nivd, dvertiid)
    147 
    148 C
    149 C  Appels a histdef pour la definition des variables a sauvegarder
    150        
    151         CALL histdef(fileid, "phis", "Surface geop. height", "-",
    152      .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
    153      .                "once", t_ops, t_wrt)
    154 
    155          CALL histdef(fileid, "aire", "Grid area", "-",
    156      .                iip1,jjp1,thoriid, 1,1,1, -99, 32,
    157      .                "once", t_ops, t_wrt)
    158        
    159         CALL histdef(filedid, "dtvr", "tps dyn", "s",
    160      .                1,1,dhoriid, 1,1,1, -99, 32,
    161      .                "once", t_ops, t_wrt)
    162        
    163          CALL histdef(filedid, "istdyn", "tps stock", "s",
    164      .                1,1,dhoriid, 1,1,1, -99, 32,
    165      .                "once", t_ops, t_wrt)
    166          
    167          CALL histdef(filedid, "istphy", "tps stock phy", "s",
    168      .                1,1,dhoriid, 1,1,1, -99, 32,
    169      .                "once", t_ops, t_wrt)
    170 
    171 
    172 C
    173 C Masse
    174 C
    175       call histdef(fileid, 'masse', 'Masse', 'kg',
    176      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    177      .             32, 'inst(X)', t_ops, t_wrt)
    178 C
    179 C  Pbaru
    180 C
    181       call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s',
    182      .             iip1, jjp1, uhoriid, llm, 1, llm, zvertiid,
    183      .             32, 'inst(X)', t_ops, t_wrt)
    184 
    185 C
    186 C  Pbarv
    187 C
    188       call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s',
    189      .             iip1, jjm, vhoriid, llm, 1, llm, zvertiid,
    190      .             32, 'inst(X)', t_ops, t_wrt)
    191 C
    192 C  w
    193 C
    194       call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s',
    195      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    196      .             32, 'inst(X)', t_ops, t_wrt)
    197 
    198 C
    199 C  Temperature potentielle
    200 C
    201       call histdef(fileid, 'teta', 'temperature potentielle', '-',
    202      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    203      .             32, 'inst(X)', t_ops, t_wrt)
    204 C
    205 
    206 C
    207 C Geopotentiel
    208 C
    209       call histdef(fileid, 'phi', 'geopotentiel instantane', '-',
    210      .             iip1, jjp1, thoriid, llm, 1, llm, zvertiid,
    211      .             32, 'inst(X)', t_ops, t_wrt)
    212 C
    213 C  Fin
    214 C
    215       call histend(fileid)
    216       call histend(filevid)
    217       call histend(filedid)
    218       if (ok_sync) then
    219         call histsync(fileid)
    220         call histsync(filevid)
    221         call histsync(filedid)
    222       endif
    223        
     57  ! This routine needs IOIPSL to work
     58  !   Variables locales
     59  !
     60  real :: nivd(1)
     61  integer :: tau0
     62  real :: zjulian
     63  character(len=3) :: str
     64  character(len=10) :: ctrac
     65  integer :: iq
     66  real :: rlong(iip1,jjp1), rlat(iip1,jjp1),rl(1,1)
     67  integer :: uhoriid, vhoriid, thoriid, zvertiid,dhoriid,dvertiid
     68  integer :: ii,jj
     69  integer :: zan, idayref
     70  logical :: ok_sync
     71  !
     72  !  Initialisations
     73  !
     74  pi = 4. * atan (1.)
     75  str='q  '
     76  ctrac = 'traceur   '
     77  ok_sync = .true.
     78  !
     79  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
     80  !
     81
     82  zan = annee_ref
     83  idayref = day_ref
     84  CALL ymds2ju(zan, 1, idayref, 0.0, zjulian)
     85  tau0 = itau_dyn
     86
     87    do jj = 1, jjp1
     88    do ii = 1, iip1
     89      rlong(ii,jj) = rlonu(ii) * 180. / pi
     90      rlat(ii,jj) = rlatu(jj) * 180. / pi
     91    enddo
     92  enddo
     93
     94  call histbeg(infile, iip1, rlong(:,1), jjp1, rlat(1,:), &
     95        1, iip1, 1, jjp1, &
     96        tau0, zjulian, tstep, uhoriid, fileid)
     97  !
     98  !  Creation du fichier histoire pour la grille en V (oblige pour l'instant,
     99  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
     100  !  un meme fichier)
     101
     102
     103  do jj = 1, jjm
     104    do ii = 1, iip1
     105      rlong(ii,jj) = rlonv(ii) * 180. / pi
     106      rlat(ii,jj) = rlatv(jj) * 180. / pi
     107    enddo
     108  enddo
     109
     110  call histbeg('fluxstokev.nc', iip1, rlong(:,1), jjm, rlat(1,:), &
     111        1, iip1, 1, jjm, &
     112        tau0, zjulian, tstep, vhoriid, filevid)
     113
     114    rl(1,1) = 1.
     115  call histbeg('defstoke.nc', 1, rl, 1, rl, &
     116        1, 1, 1, 1, &
     117        tau0, zjulian, tstep, dhoriid, filedid)
     118
     119  !
     120  !  Appel a histhori pour rajouter les autres grilles horizontales
     121  !
     122  do jj = 1, jjp1
     123    do ii = 1, iip1
     124      rlong(ii,jj) = rlonv(ii) * 180. / pi
     125      rlat(ii,jj) = rlatu(jj) * 180. / pi
     126    enddo
     127  enddo
     128
     129  call histhori(fileid, iip1, rlong, jjp1, rlat, 'scalar', &
     130        'Grille points scalaires', thoriid)
     131
     132  !
     133  !  Appel a histvert pour la grille verticale
     134  !
     135  call histvert(fileid, 'sig_s', 'Niveaux sigma', &
     136        'sigma_level', &
     137        llm, nivsigs, zvertiid)
     138  ! Pour le fichier V
     139  call histvert(filevid, 'sig_s', 'Niveaux sigma', &
     140        'sigma_level', &
     141        llm, nivsigs, zvertiid)
     142  ! pour le fichier def
     143  nivd(1) = 1
     144  call histvert(filedid, 'sig_s', 'Niveaux sigma', &
     145        'sigma_level', &
     146        1, nivd, dvertiid)
     147
     148  !
     149  !  Appels a histdef pour la definition des variables a sauvegarder
     150
     151    CALL histdef(fileid, "phis", "Surface geop. height", "-", &
     152          iip1,jjp1,thoriid, 1,1,1, -99, 32, &
     153          "once", t_ops, t_wrt)
     154
     155     CALL histdef(fileid, "aire", "Grid area", "-", &
     156           iip1,jjp1,thoriid, 1,1,1, -99, 32, &
     157           "once", t_ops, t_wrt)
     158
     159    CALL histdef(filedid, "dtvr", "tps dyn", "s", &
     160          1,1,dhoriid, 1,1,1, -99, 32, &
     161          "once", t_ops, t_wrt)
     162
     163     CALL histdef(filedid, "istdyn", "tps stock", "s", &
     164           1,1,dhoriid, 1,1,1, -99, 32, &
     165           "once", t_ops, t_wrt)
     166
     167     CALL histdef(filedid, "istphy", "tps stock phy", "s", &
     168           1,1,dhoriid, 1,1,1, -99, 32, &
     169           "once", t_ops, t_wrt)
     170
     171
     172  !
     173  ! Masse
     174  !
     175  call histdef(fileid, 'masse', 'Masse', 'kg', &
     176        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     177        32, 'inst(X)', t_ops, t_wrt)
     178  !
     179  !  Pbaru
     180  !
     181  call histdef(fileid, 'pbaru', 'flx de masse zonal', 'kg m/s', &
     182        iip1, jjp1, uhoriid, llm, 1, llm, zvertiid, &
     183        32, 'inst(X)', t_ops, t_wrt)
     184
     185  !
     186  !  Pbarv
     187  !
     188  call histdef(filevid, 'pbarv', 'flx de masse mer', 'kg m/s', &
     189        iip1, jjm, vhoriid, llm, 1, llm, zvertiid, &
     190        32, 'inst(X)', t_ops, t_wrt)
     191  !
     192  !  w
     193  !
     194  call histdef(fileid, 'w', 'flx de masse vert', 'kg m/s', &
     195        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     196        32, 'inst(X)', t_ops, t_wrt)
     197
     198  !
     199  !  Temperature potentielle
     200  !
     201  call histdef(fileid, 'teta', 'temperature potentielle', '-', &
     202        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     203        32, 'inst(X)', t_ops, t_wrt)
     204  !
     205
     206  !
     207  ! Geopotentiel
     208  !
     209  call histdef(fileid, 'phi', 'geopotentiel instantane', '-', &
     210        iip1, jjp1, thoriid, llm, 1, llm, zvertiid, &
     211        32, 'inst(X)', t_ops, t_wrt)
     212  !
     213  !  Fin
     214  !
     215  call histend(fileid)
     216  call histend(filevid)
     217  call histend(filedid)
     218  if (ok_sync) then
     219    call histsync(fileid)
     220    call histsync(filevid)
     221    call histsync(filedid)
     222  endif
     223
    224224#else
    225 ! tell the user this routine should be run with ioipsl
    226       write(lunout,*)"initfluxsto: Warning this routine should not be",
    227      &               " used without ioipsl"
     225  ! tell the user this routine should be run with ioipsl
     226  write(lunout,*)"initfluxsto: Warning this routine should not be", &
     227        " used without ioipsl"
    228228#endif
    229 ! of #ifdef CPP_IOIPSL
    230       return
    231       end
     229  ! of #ifdef CPP_IOIPSL
     230  return
     231end subroutine initfluxsto
Note: See TracChangeset for help on using the changeset viewer.