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/writedynav_loc.F90

    r5245 r5246  
    22! $Id: writedynav_p.F 1279 2009-12-10 09:02:56Z fairhead $
    33!
    4       subroutine writedynav_loc( time, vcov, ucov,teta,ppk,phi,q,
    5      .                           masse,ps,phis)
     4subroutine writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, &
     5        masse,ps,phis)
    66
    77#ifdef CPP_IOIPSL
    8 ! This routine needs IOIPSL
    9       USE ioipsl
     8  ! This routine needs IOIPSL
     9  USE ioipsl
    1010#endif
    11       USE parallel_lmdz
    12       USE misc_mod
    13       USE infotrac, ONLY : nqtot
    14       use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
    15       USE comconst_mod, ONLY: cpp
    16       USE temps_mod, ONLY: itau_dyn
    17      
    18       implicit none
    19 
    20 C
    21 C   Ecriture du fichier histoire au format IOIPSL
    22 C
    23 C   Appels succesifs des routines: histwrite
    24 C
    25 C   Entree:
    26 C      histid: ID du fichier histoire
    27 C      time: temps de l'ecriture
    28 C      vcov: vents v covariants
    29 C      ucov: vents u covariants
    30 C      teta: temperature potentielle
    31 C      phi : geopotentiel instantane
    32 C      q   : traceurs
    33 C      masse: masse
    34 C      ps   :pression au sol
    35 C      phis : geopotentiel au sol
    36 C     
    37 C
    38 C   Sortie:
    39 C      fileid: ID du fichier netcdf cree
    40 C
    41 C   L. Fairhead, LMD, 03/99
    42 C
    43 C =====================================================================
    44 C
    45 C   Declarations
    46       include "dimensions.h"
    47       include "paramet.h"
    48       include "comgeom.h"
    49       include "description.h"
    50       include "iniprint.h"
    51 
    52 C
    53 C   Arguments
    54 C
    55 
    56       REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    57       REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
    58       REAL ppk(ijb_u:ije_u,llm)                 
    59       REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
    60       REAL phis(ijb_u:ije_u)                 
    61       REAL q(ijb_u:ije_u,llm,nqtot)
    62       integer time
     11  USE parallel_lmdz
     12  USE misc_mod
     13  USE infotrac, ONLY : nqtot
     14  use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
     15  USE comconst_mod, ONLY: cpp
     16  USE temps_mod, ONLY: itau_dyn
     17
     18  implicit none
     19
     20  !
     21  !   Ecriture du fichier histoire au format IOIPSL
     22  !
     23  !   Appels succesifs des routines: histwrite
     24  !
     25  !   Entree:
     26  !  histid: ID du fichier histoire
     27  !  time: temps de l'ecriture
     28  !  vcov: vents v covariants
     29  !  ucov: vents u covariants
     30  !  teta: temperature potentielle
     31  !  phi : geopotentiel instantane
     32  !  q   : traceurs
     33  !  masse: masse
     34  !  ps   :pression au sol
     35  !  phis : geopotentiel au sol
     36  !
     37  !
     38  !   Sortie:
     39  !  fileid: ID du fichier netcdf cree
     40  !
     41  !   L. Fairhead, LMD, 03/99
     42  !
     43  ! =====================================================================
     44  !
     45  !   Declarations
     46  include "dimensions.h"
     47  include "paramet.h"
     48  include "comgeom.h"
     49  include "description.h"
     50  include "iniprint.h"
     51
     52  !
     53  !   Arguments
     54  !
     55
     56  REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
     57  REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
     58  REAL :: ppk(ijb_u:ije_u,llm)
     59  REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)
     60  REAL :: phis(ijb_u:ije_u)
     61  REAL :: q(ijb_u:ije_u,llm,nqtot)
     62  integer :: time
    6363
    6464
    6565#ifdef CPP_IOIPSL
    66 ! This routine needs IOIPSL
    67 C   Variables locales
    68 C
    69       INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
    70       INTEGER :: iq, ii, ll
    71       REAL,SAVE,ALLOCATABLE :: tm(:,:)
    72       REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
    73       logical ok_sync
    74       integer itau_w
    75       integer :: ijb,ije,jjn
    76       LOGICAL,SAVE :: first=.TRUE.
     66  ! This routine needs IOIPSL
     67  !   Variables locales
     68  !
     69  INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
     70  INTEGER :: iq, ii, ll
     71  REAL,SAVE,ALLOCATABLE :: tm(:,:)
     72  REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
     73  logical :: ok_sync
     74  integer :: itau_w
     75  integer :: ijb,ije,jjn
     76  LOGICAL,SAVE :: first=.TRUE.
    7777!$OMP THREADPRIVATE(first)
    7878
    79 C
    80 C  Initialisations
    81 C
    82       if (adjust) return
    83      
    84       IF (first) THEN
    85 !$OMP BARRIER
    86 !$OMP MASTER
    87         ALLOCATE(unat(ijb_u:ije_u,llm))
    88         ALLOCATE(vnat(ijb_v:ije_v,llm))
    89         ALLOCATE(tm(ijb_u:ije_u,llm))
    90         ALLOCATE(ndex2d(ijnb_u*llm))
    91         ALLOCATE(ndexu(ijnb_u*llm))
    92         ALLOCATE(ndexv(ijnb_v*llm))
    93         ndex2d = 0
    94         ndexu = 0
    95         ndexv = 0
    96 !$OMP END MASTER
    97 !$OMP BARRIER
    98         first=.FALSE.
    99       ENDIF
    100      
    101       ok_sync = .TRUE.
    102       itau_w = itau_dyn + time
    103 
    104 C Passage aux composantes naturelles du vent
    105       call covnat_loc(llm, ucov, vcov, unat, vnat)
    106 
    107 C
    108 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    109 C
    110 C  Vents U
    111 C
    112 
    113 !$OMP BARRIER     
    114 !$OMP MASTER
    115       ijb=ij_begin
    116       ije=ij_end
    117       jjn=jj_nb
    118      
    119       call histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:),
    120      .               iip1*jjn*llm, ndexu)
    121 !$OMP END MASTER     
    122 
    123 C
    124 C  Vents V
    125 C
    126       ije=ij_end
    127       if (pole_sud) jjn=jj_nb-1
    128       if (pole_sud) ije=ij_end-iip1
    129 !$OMP BARRIER
    130 !$OMP MASTER     
    131       call histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:),
    132      .               iip1*jjn*llm, ndexv)
    133 !$OMP END MASTER     
    134 
    135 
    136 C
    137 C  Temperature potentielle moyennee
    138 C
    139       ijb=ij_begin
    140       ije=ij_end
    141       jjn=jj_nb
    142 !$OMP MASTER     
    143       call histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:),
    144      .                iip1*jjn*llm, ndexu)
    145 !$OMP END MASTER     
    146 
    147 C
    148 C  Temperature moyennee
    149 C
    150 
    151 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)       
    152       do ll=1,llm
    153         do ii = ijb, ije
    154           tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
    155         enddo
    156       enddo
     79  !
     80  !  Initialisations
     81  !
     82  if (adjust) return
     83
     84  IF (first) THEN
     85!$OMP BARRIER
     86!$OMP MASTER
     87    ALLOCATE(unat(ijb_u:ije_u,llm))
     88    ALLOCATE(vnat(ijb_v:ije_v,llm))
     89    ALLOCATE(tm(ijb_u:ije_u,llm))
     90    ALLOCATE(ndex2d(ijnb_u*llm))
     91    ALLOCATE(ndexu(ijnb_u*llm))
     92    ALLOCATE(ndexv(ijnb_v*llm))
     93    ndex2d = 0
     94    ndexu = 0
     95    ndexv = 0
     96!$OMP END MASTER
     97!$OMP BARRIER
     98    first=.FALSE.
     99  ENDIF
     100
     101  ok_sync = .TRUE.
     102  itau_w = itau_dyn + time
     103
     104  ! Passage aux composantes naturelles du vent
     105  call covnat_loc(llm, ucov, vcov, unat, vnat)
     106
     107  !
     108  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     109  !
     110  !  Vents U
     111  !
     112
     113!$OMP BARRIER
     114!$OMP MASTER
     115  ijb=ij_begin
     116  ije=ij_end
     117  jjn=jj_nb
     118
     119  call histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:), &
     120        iip1*jjn*llm, ndexu)
     121!$OMP END MASTER
     122
     123  !
     124  !  Vents V
     125  !
     126  ije=ij_end
     127  if (pole_sud) jjn=jj_nb-1
     128  if (pole_sud) ije=ij_end-iip1
     129!$OMP BARRIER
     130!$OMP MASTER
     131  call histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:), &
     132        iip1*jjn*llm, ndexv)
     133!$OMP END MASTER
     134
     135
     136  !
     137  !  Temperature potentielle moyennee
     138  !
     139  ijb=ij_begin
     140  ije=ij_end
     141  jjn=jj_nb
     142!$OMP MASTER
     143  call histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:), &
     144        iip1*jjn*llm, ndexu)
     145!$OMP END MASTER
     146
     147  !
     148  !  Temperature moyennee
     149  !
     150
     151!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
     152  do ll=1,llm
     153    do ii = ijb, ije
     154      tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
     155    enddo
     156  enddo
    157157!$OMP ENDDO
    158158
    159 !$OMP MASTER     
    160       call histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:),
    161      .                iip1*jjn*llm, ndexu)
    162 !$OMP END MASTER
    163 
    164 
    165 C
    166 C  Geopotentiel
    167 C
    168 !$OMP MASTER     
    169       call histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:),
    170      .                iip1*jjn*llm, ndexu)
    171 !$OMP END MASTER
    172 
    173 
    174 C
    175 C  Traceurs
    176 C
    177 !!$OMP MASTER     
    178 !        DO iq=1,nqtot
    179 !          call histwrite(histaveid, tracers(iq)%longName, itau_w, &
    180 !    .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
    181 !        enddo
    182 !!$OMP END MASTER
    183 
    184 
    185 C
    186 C  Masse
    187 C
    188 !$OMP MASTER     
    189        call histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:),
    190      .                iip1*jjn*llm, ndexu)
    191 !$OMP END MASTER
    192 
    193 
    194 C
    195 C  Pression au sol
    196 C
    197 !$OMP MASTER     
    198 
    199        call histwrite(histaveid, 'ps', itau_w, ps(ijb:ije),
    200      .                 iip1*jjn, ndex2d)
    201 !$OMP END MASTER
    202 
    203 C
    204 C  Geopotentiel au sol
    205 C
    206 !$OMP MASTER     
    207 !      call histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
    208 !    .                 iip1*jjn, ndex2d)
    209 !$OMP END MASTER
    210 
    211 C
    212 C  Fin
    213 C
    214 !$OMP MASTER     
    215       if (ok_sync) then
    216           call histsync(histaveid)
    217           call histsync(histvaveid)
    218           call histsync(histuaveid)
    219       ENDIF
     159!$OMP MASTER
     160  call histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:), &
     161        iip1*jjn*llm, ndexu)
     162!$OMP END MASTER
     163
     164
     165  !
     166  !  Geopotentiel
     167  !
     168!$OMP MASTER
     169  call histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:), &
     170        iip1*jjn*llm, ndexu)
     171!$OMP END MASTER
     172
     173
     174  !
     175  !  Traceurs
     176  !
     177  !!$OMP MASTER
     178  !    DO iq=1,nqtot
     179  !      call histwrite(histaveid, tracers(iq)%longName, itau_w, &
     180  ! .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
     181  !    enddo
     182  !!$OMP END MASTER
     183
     184
     185  !
     186  !  Masse
     187  !
     188!$OMP MASTER
     189   call histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), &
     190         iip1*jjn*llm, ndexu)
     191!$OMP END MASTER
     192
     193
     194  !
     195  !  Pression au sol
     196  !
     197!$OMP MASTER
     198
     199   call histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
     200         iip1*jjn, ndex2d)
     201!$OMP END MASTER
     202
     203  !
     204  !  Geopotentiel au sol
     205  !
     206!$OMP MASTER
     207    ! call histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
     208  ! .                 iip1*jjn, ndex2d)
     209!$OMP END MASTER
     210
     211  !
     212  !  Fin
     213  !
     214!$OMP MASTER
     215  if (ok_sync) then
     216      call histsync(histaveid)
     217      call histsync(histvaveid)
     218      call histsync(histuaveid)
     219  ENDIF
    220220!$OMP END MASTER
    221221#else
    222       write(lunout,*)'writedynav_loc: Needs IOIPSL to function'
     222  write(lunout,*)'writedynav_loc: Needs IOIPSL to function'
    223223#endif
    224 ! #endif of #ifdef CPP_IOIPSL
    225       end
     224  ! #endif of #ifdef CPP_IOIPSL
     225end subroutine writedynav_loc
Note: See TracChangeset for help on using the changeset viewer.