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/dyn3dmem/initdynav_loc.F90

    r5245 r5246  
    22! $Id: initdynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    33!
    4       subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt)
     4subroutine initdynav_loc(day0,anne0,tstep,t_ops,t_wrt)
    55
    66#ifdef CPP_IOIPSL
    7 ! This routine needs IOIPSL
    8        USE IOIPSL
     7  ! This routine needs IOIPSL
     8   USE IOIPSL
    99#endif
    10        USE parallel_lmdz
    11        use Write_field
    12        use misc_mod
    13 !      USE infotrac
    14        use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
    15      &        dynhistave_file,dynhistvave_file,dynhistuave_file
    16        USE comconst_mod, ONLY: pi
    17        USE comvert_mod, ONLY: presnivs
    18        USE temps_mod, ONLY: itau_dyn
    19        
    20        implicit none
    21 
    22 C
    23 C   Routine d'initialisation des ecritures des fichiers histoires LMDZ
    24 C   au format IOIPSL. Initialisation du fichier histoire moyenne.
    25 C
    26 C   Appels succesifs des routines: histbeg
    27 C                                  histhori
    28 C                                  histver
    29 C                                  histdef
    30 C                                  histend
    31 C
    32 C   Entree:
    33 C
    34 C      day0,anne0: date de reference
    35 C      tstep : frequence d'ecriture
    36 C      t_ops: frequence de l'operation pour IOIPSL
    37 C      t_wrt: frequence d'ecriture sur le fichier
    38 C
    39 C   Sortie:
    40 C      fileid: ID du fichier netcdf cree
    41 C
    42 C   L. Fairhead, LMD, 03/99
    43 C
    44 C =====================================================================
    45 C
    46 C   Declarations
    47       include "dimensions.h"
    48       include "paramet.h"
    49       include "comgeom.h"
    50       include "description.h"
    51       include "iniprint.h"
    52 
    53 C   Arguments
    54 C
    55       integer*4 day0, anne0
    56       real tstep, t_ops, t_wrt
     10   USE parallel_lmdz
     11   use Write_field
     12   use misc_mod
     13    ! USE infotrac
     14   use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid,       &
     15         dynhistave_file,dynhistvave_file,dynhistuave_file
     16   USE comconst_mod, ONLY: pi
     17   USE comvert_mod, ONLY: presnivs
     18   USE temps_mod, ONLY: itau_dyn
     19
     20   implicit none
     21
     22  !
     23  !   Routine d'initialisation des ecritures des fichiers histoires LMDZ
     24  !   au format IOIPSL. Initialisation du fichier histoire moyenne.
     25  !
     26  !   Appels succesifs des routines: histbeg
     27  !                              histhori
     28  !                              histver
     29  !                              histdef
     30  !                              histend
     31  !
     32  !   Entree:
     33  !
     34  !  day0,anne0: date de reference
     35  !  tstep : frequence d'ecriture
     36  !  t_ops: frequence de l'operation pour IOIPSL
     37  !  t_wrt: frequence d'ecriture sur le fichier
     38  !
     39  !   Sortie:
     40  !  fileid: ID du fichier netcdf cree
     41  !
     42  !   L. Fairhead, LMD, 03/99
     43  !
     44  ! =====================================================================
     45  !
     46  !   Declarations
     47  include "dimensions.h"
     48  include "paramet.h"
     49  include "comgeom.h"
     50  include "description.h"
     51  include "iniprint.h"
     52
     53  !   Arguments
     54  !
     55  integer(kind=4) :: day0, anne0
     56  real :: tstep, t_ops, t_wrt
    5757
    5858#ifdef CPP_IOIPSL
    59 ! This routine needs IOIPSL
    60 C   Variables locales
    61 C
    62       integer tau0
    63       real zjulian
    64       integer iq
    65       real rlong(iip1,jjp1), rlat(iip1,jjp1)
    66       integer uhoriid, vhoriid, thoriid
    67       integer zvertiid,zvertiidv,zvertiidu
    68       integer ii,jj
    69       integer zan, dayref
    70       integer :: jjb,jje,jjn
    71 
    72 ! definition du domaine d'ecriture pour le rebuild
    73 
    74       INTEGER,DIMENSION(2) :: ddid
    75       INTEGER,DIMENSION(2) :: dsg
    76       INTEGER,DIMENSION(2) :: dsl
    77       INTEGER,DIMENSION(2) :: dpf
    78       INTEGER,DIMENSION(2) :: dpl
    79       INTEGER,DIMENSION(2) :: dhs
    80       INTEGER,DIMENSION(2) :: dhe
    81      
    82       INTEGER :: dynhistave_domain_id
    83       INTEGER :: dynhistvave_domain_id
    84       INTEGER :: dynhistuave_domain_id
    85      
    86       if (adjust) return
    87 
    88 C
    89 C  Initialisations
    90 C
    91       pi = 4. * atan (1.)
    92 C
    93 C  Appel a histbeg: creation du fichier netcdf et initialisations diverses
    94 C         
    95 
    96       zan = anne0
    97       dayref = day0
    98       CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
    99       tau0 = itau_dyn
    100      
    101       do jj = 1, jjp1
    102         do ii = 1, iip1
    103           rlong(ii,jj) = rlonv(ii) * 180. / pi
    104           rlat(ii,jj)  = rlatu(jj) * 180. / pi
    105         enddo
    106       enddo
    107 
    108 
    109 ! Creation de 3 fichiers pour les differentes grilles horizontales
    110 ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
    111 ! Grille Scalaire       
    112 
    113       jjb=jj_begin
    114       jje=jj_end
    115       jjn=jj_nb
    116 
    117       ddid=(/ 1,2 /)
    118       dsg=(/ iip1,jjp1 /)
    119       dsl=(/ iip1,jjn /)
    120       dpf=(/ 1,jjb /)
    121       dpl=(/ iip1,jje /)
    122       dhs=(/ 0,0 /)
    123       dhe=(/ 0,0 /)
    124 
    125 
    126       call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
    127      .                 'box',dynhistave_domain_id)
    128              
    129       call histbeg(dynhistave_file,iip1, rlong(:,1), jjn,
    130      .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
    131      .             zjulian, tstep, thoriid,
    132      .             histaveid,dynhistave_domain_id)
    133 
    134 
    135 C  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
    136 C  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
    137 C  un meme fichier)
    138 ! Grille V
    139 
    140       jjb=jj_begin
    141       jje=jj_end
    142       jjn=jj_nb
    143       IF (pole_sud) jjn=jjn-1
    144       IF (pole_sud) jje=jje-1
    145      
    146       do jj = jjb, jje
    147         do ii = 1, iip1
    148           rlong(ii,jj) = rlonv(ii) * 180. / pi
    149           rlat(ii,jj) = rlatv(jj) * 180. / pi
    150         enddo
    151       enddo
    152 
    153       ddid=(/ 1,2 /)
    154       dsg=(/ iip1,jjm /)
    155       dsl=(/ iip1,jjn /)
    156       dpf=(/ 1,jjb /)
    157       dpl=(/ iip1,jje /)
    158       dhs=(/ 0,0 /)
    159       dhe=(/ 0,0 /)
    160 
    161 
    162       call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
    163      .                 'box',dynhistvave_domain_id)
    164 
    165       call histbeg(dynhistvave_file,iip1, rlong(:,1), jjn,
    166      .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
    167      .             zjulian, tstep, vhoriid,
    168      .             histvaveid,dynhistvave_domain_id)
    169      
    170 ! Grille U
    171 
    172       do jj = 1, jjp1
    173         do ii = 1, iip1
    174           rlong(ii,jj) = rlonu(ii) * 180. / pi
    175           rlat(ii,jj) = rlatu(jj) * 180. / pi
    176         enddo
    177       enddo
    178 
    179       jjb=jj_begin
    180       jje=jj_end
    181       jjn=jj_nb
    182 
    183       ddid=(/ 1,2 /)
    184       dsg=(/ iip1,jjp1 /)
    185       dsl=(/ iip1,jjn /)
    186       dpf=(/ 1,jjb /)
    187       dpl=(/ iip1,jje /)
    188       dhs=(/ 0,0 /)
    189       dhe=(/ 0,0 /)
    190 
    191 
    192       call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe,
    193      .                 'box',dynhistuave_domain_id)
    194              
    195       call histbeg(dynhistuave_file,iip1, rlong(:,1), jjn,
    196      .             rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0,
    197      .             zjulian, tstep, uhoriid,
    198      .             histuaveid,dynhistuave_domain_id)
    199      
    200      
    201 C
    202 C  Appel a histvert pour la grille verticale
    203 C
    204       call histvert(histaveid,'presnivs','Niveaux Pression
    205      &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
    206       call histvert(histuaveid,'presnivs','Niveaux Pression
    207      &     approximatifs','mb',llm, presnivs/100., zvertiidv,'down')
    208       call histvert(histvaveid,'presnivs','Niveaux Pression
    209      &     approximatifs','mb',llm, presnivs/100., zvertiidu,'down')
    210 
    211 C
    212 C  Appels a histdef pour la definition des variables a sauvegarder
    213 C
    214 C  Vents U
    215 C
    216       jjn=jj_nb
    217       call histdef(histuaveid, 'u', 'vent u moyen ',
    218      .             'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu,
    219      .             32, 'ave(X)', t_ops, t_wrt)
    220 
    221 C
    222 C  Vents V
    223 C
    224       if (pole_sud) jjn=jj_nb-1
    225       call histdef(histvaveid, 'v', 'vent v moyen',
    226      .             'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv,
    227      .             32, 'ave(X)', t_ops, t_wrt)
    228 
    229 C
    230 C  Temperature
    231 C
    232       jjn=jj_nb
    233       call histdef(histaveid, 'temp', 'temperature moyenne', 'K',
    234      .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    235      .             32, 'ave(X)', t_ops, t_wrt)
    236 C
    237 C  Temperature potentielle
    238 C
    239       call histdef(histaveid, 'theta', 'temperature potentielle', 'K',
    240      .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    241      .             32, 'ave(X)', t_ops, t_wrt)
    242 
    243 
    244 C
    245 C  Geopotentiel
    246 C
    247       call histdef(histaveid, 'phi', 'geopotentiel moyen', '-',
    248      .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    249      .             32, 'ave(X)', t_ops, t_wrt)
    250 C
    251 C  Traceurs
    252 C
    253 !        DO iq=1,nqtot
    254 !          call histdef(histaveid, tracers(iq)%name,
    255 !    .                            tracers(iq)%longName, '-',
    256 !    .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    257 !    .             32, 'ave(X)', t_ops, t_wrt)
    258 !        enddo
    259 C
    260 C  Masse
    261 C
    262       call histdef(histaveid, 'masse', 'masse moyenne', 'kg',
    263      .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
    264      .             32, 'ave(X)', t_ops, t_wrt)
    265 C
    266 C  Pression au sol
    267 C
    268       call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa',
    269      .             iip1, jjn, thoriid, 1, 1, 1, -99,
    270      .             32, 'ave(X)', t_ops, t_wrt)
    271 C
    272 C  Geopotentiel au sol
    273 C
    274 !      call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
    275 !    .             iip1, jjn, thoriid, 1, 1, 1, -99,
    276 !    .             32, 'ave(X)', t_ops, t_wrt)
    277 C
    278 C  Fin
    279 C
    280       call histend(histaveid)
    281       call histend(histuaveid)
    282       call histend(histvaveid)
     59  ! This routine needs IOIPSL
     60  !   Variables locales
     61  !
     62  integer :: tau0
     63  real :: zjulian
     64  integer :: iq
     65  real :: rlong(iip1,jjp1), rlat(iip1,jjp1)
     66  integer :: uhoriid, vhoriid, thoriid
     67  integer :: zvertiid,zvertiidv,zvertiidu
     68  integer :: ii,jj
     69  integer :: zan, dayref
     70  integer :: jjb,jje,jjn
     71
     72  ! definition du domaine d'ecriture pour le rebuild
     73
     74  INTEGER,DIMENSION(2) :: ddid
     75  INTEGER,DIMENSION(2) :: dsg
     76  INTEGER,DIMENSION(2) :: dsl
     77  INTEGER,DIMENSION(2) :: dpf
     78  INTEGER,DIMENSION(2) :: dpl
     79  INTEGER,DIMENSION(2) :: dhs
     80  INTEGER,DIMENSION(2) :: dhe
     81
     82  INTEGER :: dynhistave_domain_id
     83  INTEGER :: dynhistvave_domain_id
     84  INTEGER :: dynhistuave_domain_id
     85
     86  if (adjust) return
     87
     88  !
     89  !  Initialisations
     90  !
     91  pi = 4. * atan (1.)
     92  !
     93  !  Appel a histbeg: creation du fichier netcdf et initialisations diverses
     94  !
     95
     96  zan = anne0
     97  dayref = day0
     98  CALL ymds2ju(zan, 1, dayref, 0.0, zjulian)
     99  tau0 = itau_dyn
     100
     101  do jj = 1, jjp1
     102    do ii = 1, iip1
     103      rlong(ii,jj) = rlonv(ii) * 180. / pi
     104      rlat(ii,jj)  = rlatu(jj) * 180. / pi
     105    enddo
     106  enddo
     107
     108
     109  ! Creation de 3 fichiers pour les differentes grilles horizontales
     110  ! Restriction de IOIPSL: seulement 2 coordonnees dans le meme fichier
     111  ! Grille Scalaire
     112
     113  jjb=jj_begin
     114  jje=jj_end
     115  jjn=jj_nb
     116
     117  ddid=(/ 1,2 /)
     118  dsg=(/ iip1,jjp1 /)
     119  dsl=(/ iip1,jjn /)
     120  dpf=(/ 1,jjb /)
     121  dpl=(/ iip1,jje /)
     122  dhs=(/ 0,0 /)
     123  dhe=(/ 0,0 /)
     124
     125
     126  call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
     127        'box',dynhistave_domain_id)
     128
     129  call histbeg(dynhistave_file,iip1, rlong(:,1), jjn, &
     130        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
     131        zjulian, tstep, thoriid, &
     132        histaveid,dynhistave_domain_id)
     133
     134
     135  !  Creation du fichier histoire pour les grilles en V et U (oblige pour l'instant,
     136  !  IOIPSL ne permet pas de grilles avec des nombres de point differents dans
     137  !  un meme fichier)
     138  ! Grille V
     139
     140  jjb=jj_begin
     141  jje=jj_end
     142  jjn=jj_nb
     143  IF (pole_sud) jjn=jjn-1
     144  IF (pole_sud) jje=jje-1
     145
     146  do jj = jjb, jje
     147    do ii = 1, iip1
     148      rlong(ii,jj) = rlonv(ii) * 180. / pi
     149      rlat(ii,jj) = rlatv(jj) * 180. / pi
     150    enddo
     151  enddo
     152
     153  ddid=(/ 1,2 /)
     154  dsg=(/ iip1,jjm /)
     155  dsl=(/ iip1,jjn /)
     156  dpf=(/ 1,jjb /)
     157  dpl=(/ iip1,jje /)
     158  dhs=(/ 0,0 /)
     159  dhe=(/ 0,0 /)
     160
     161
     162  call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
     163        'box',dynhistvave_domain_id)
     164
     165  call histbeg(dynhistvave_file,iip1, rlong(:,1), jjn, &
     166        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
     167        zjulian, tstep, vhoriid, &
     168        histvaveid,dynhistvave_domain_id)
     169
     170  ! Grille U
     171
     172  do jj = 1, jjp1
     173    do ii = 1, iip1
     174      rlong(ii,jj) = rlonu(ii) * 180. / pi
     175      rlat(ii,jj) = rlatu(jj) * 180. / pi
     176    enddo
     177  enddo
     178
     179  jjb=jj_begin
     180  jje=jj_end
     181  jjn=jj_nb
     182
     183  ddid=(/ 1,2 /)
     184  dsg=(/ iip1,jjp1 /)
     185  dsl=(/ iip1,jjn /)
     186  dpf=(/ 1,jjb /)
     187  dpl=(/ iip1,jje /)
     188  dhs=(/ 0,0 /)
     189  dhe=(/ 0,0 /)
     190
     191
     192  call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
     193        'box',dynhistuave_domain_id)
     194
     195  call histbeg(dynhistuave_file,iip1, rlong(:,1), jjn, &
     196        rlat(1,jjb:jje), 1, iip1, 1, jjn,tau0, &
     197        zjulian, tstep, uhoriid, &
     198        histuaveid,dynhistuave_domain_id)
     199
     200
     201  !
     202  !  Appel a histvert pour la grille verticale
     203  !
     204  call histvert(histaveid,'presnivs','Niveaux Pression&
     205        &     approximatifs','mb',llm, presnivs/100., zvertiid,'down')
     206  call histvert(histuaveid,'presnivs','Niveaux Pression&
     207        &     approximatifs','mb',llm, presnivs/100., zvertiidv,'down')
     208  call histvert(histvaveid,'presnivs','Niveaux Pression&
     209        &     approximatifs','mb',llm, presnivs/100., zvertiidu,'down')
     210
     211  !
     212  !  Appels a histdef pour la definition des variables a sauvegarder
     213  !
     214  !  Vents U
     215  !
     216  jjn=jj_nb
     217  call histdef(histuaveid, 'u', 'vent u moyen ', &
     218        'm/s', iip1, jjn, uhoriid, llm, 1, llm, zvertiidu, &
     219        32, 'ave(X)', t_ops, t_wrt)
     220
     221  !
     222  !  Vents V
     223  !
     224  if (pole_sud) jjn=jj_nb-1
     225  call histdef(histvaveid, 'v', 'vent v moyen', &
     226        'm/s', iip1, jjn, vhoriid, llm, 1, llm, zvertiidv, &
     227        32, 'ave(X)', t_ops, t_wrt)
     228
     229  !
     230  !  Temperature
     231  !
     232  jjn=jj_nb
     233  call histdef(histaveid, 'temp', 'temperature moyenne', 'K', &
     234        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     235        32, 'ave(X)', t_ops, t_wrt)
     236  !
     237  !  Temperature potentielle
     238  !
     239  call histdef(histaveid, 'theta', 'temperature potentielle', 'K', &
     240        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     241        32, 'ave(X)', t_ops, t_wrt)
     242
     243
     244  !
     245  !  Geopotentiel
     246  !
     247  call histdef(histaveid, 'phi', 'geopotentiel moyen', '-', &
     248        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     249        32, 'ave(X)', t_ops, t_wrt)
     250  !
     251  !  Traceurs
     252  !
     253  !    DO iq=1,nqtot
     254  !      call histdef(histaveid, tracers(iq)%name,
     255  ! .                            tracers(iq)%longName, '-',
     256  ! .             iip1, jjn, thoriid, llm, 1, llm, zvertiid,
     257  ! .             32, 'ave(X)', t_ops, t_wrt)
     258  !    enddo
     259  !
     260  !  Masse
     261  !
     262  call histdef(histaveid, 'masse', 'masse moyenne', 'kg', &
     263        iip1, jjn, thoriid, llm, 1, llm, zvertiid, &
     264        32, 'ave(X)', t_ops, t_wrt)
     265  !
     266  !  Pression au sol
     267  !
     268  call histdef(histaveid, 'ps', 'pression naturelle au sol', 'Pa', &
     269        iip1, jjn, thoriid, 1, 1, 1, -99, &
     270        32, 'ave(X)', t_ops, t_wrt)
     271  !
     272  !  Geopotentiel au sol
     273  !
     274  !  call histdef(histaveid, 'phis', 'geopotentiel au sol', '-',
     275  ! .             iip1, jjn, thoriid, 1, 1, 1, -99,
     276  ! .             32, 'ave(X)', t_ops, t_wrt)
     277  !
     278  !  Fin
     279  !
     280  call histend(histaveid)
     281  call histend(histuaveid)
     282  call histend(histvaveid)
    283283#else
    284       write(lunout,*)'initdynav_loc: Needs IOIPSL to function'
     284  write(lunout,*)'initdynav_loc: Needs IOIPSL to function'
    285285#endif
    286 ! #endif of #ifdef CPP_IOIPSL
    287       end
     286  ! #endif of #ifdef CPP_IOIPSL
     287end subroutine initdynav_loc
Note: See TracChangeset for help on using the changeset viewer.