Ignore:
Timestamp:
Jul 23, 2024, 7:14:34 PM (4 months ago)
Author:
abarral
Message:

Replace 1DUTILS.h by module lmdz_1dutils.f90
Replace 1DConv.h by module lmdz_old_1dconv.f90 (it's only used by old_* files)
Convert *.F to *.f90
Fix gradsdef.h formatting
Remove unnecessary "RETURN" at the end of functions/subroutines

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/Amaury_dev/libf/dyn3dmem/writedynav_loc.f90

    r5104 r5105  
    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)
    6 
    7 ! This routine needs IOIPSL
    8       USE ioipsl
    9       USE parallel_lmdz
    10       USE misc_mod
    11       USE infotrac, ONLY: nqtot
    12       use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid
    13       USE comconst_mod, ONLY: cpp
    14       USE temps_mod, ONLY: itau_dyn
    15      
    16       implicit none
    17 
    18 C
    19 C   Ecriture du fichier histoire au format IOIPSL
    20 C
    21 C   Appels succesifs des routines: histwrite
    22 C
    23 C   Entree:
    24 C      histid: ID du fichier histoire
    25 C      time: temps de l'ecriture
    26 C      vcov: vents v covariants
    27 C      ucov: vents u covariants
    28 C      teta: temperature potentielle
    29 C      phi : geopotentiel instantane
    30 C      q   : traceurs
    31 C      masse: masse
    32 C      ps   :pression au sol
    33 C      phis : geopotentiel au sol
    34 C     
    35 C
    36 C   Sortie:
    37 C      fileid: ID du fichier netcdf cree
    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
    51 C   Arguments
    52 C
    53 
    54       REAL vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
    55       REAL teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
    56       REAL ppk(ijb_u:ije_u,llm)                 
    57       REAL ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)                   
    58       REAL phis(ijb_u:ije_u)                 
    59       REAL q(ijb_u:ije_u,llm,nqtot)
    60       integer time
    61 
    62 
    63 ! This routine needs IOIPSL
    64 C   Variables locales
    65 C
    66       INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
    67       INTEGER :: iq, ii, ll
    68       REAL,SAVE,ALLOCATABLE :: tm(:,:)
    69       REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
    70       logical ok_sync
    71       integer itau_w
    72       integer :: ijb,ije,jjn
    73       LOGICAL,SAVE :: first=.TRUE.
     4SUBROUTINE writedynav_loc( time, vcov, ucov,teta,ppk,phi,q, &
     5        masse,ps,phis)
     6
     7  ! This routine needs IOIPSL
     8  USE ioipsl
     9  USE parallel_lmdz
     10  USE misc_mod
     11  USE infotrac, ONLY: nqtot
     12  use com_io_dyn_mod, ONLY: histaveid,histvaveid,histuaveid
     13  USE comconst_mod, ONLY: cpp
     14  USE temps_mod, ONLY: itau_dyn
     15
     16  implicit none
     17
     18  !
     19  !   Ecriture du fichier histoire au format IOIPSL
     20  !
     21  !   Appels succesifs des routines: histwrite
     22  !
     23  !   Entree:
     24  !  histid: ID du fichier histoire
     25  !  time: temps de l'ecriture
     26  !  vcov: vents v covariants
     27  !  ucov: vents u covariants
     28  !  teta: temperature potentielle
     29  !  phi : geopotentiel instantane
     30  !  q   : traceurs
     31  !  masse: masse
     32  !  ps   :pression au sol
     33  !  phis : geopotentiel au sol
     34  !
     35  !
     36  !   Sortie:
     37  !  fileid: ID du fichier netcdf cree
     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  !
     51  !   Arguments
     52  !
     53
     54  REAL :: vcov(ijb_v:ije_v,llm),ucov(ijb_u:ije_u,llm)
     55  REAL :: teta(ijb_u:ije_u,llm),phi(ijb_u:ije_u,llm)
     56  REAL :: ppk(ijb_u:ije_u,llm)
     57  REAL :: ps(ijb_u:ije_u),masse(ijb_u:ije_u,llm)
     58  REAL :: phis(ijb_u:ije_u)
     59  REAL :: q(ijb_u:ije_u,llm,nqtot)
     60  integer :: time
     61
     62
     63  ! This routine needs IOIPSL
     64  !   Variables locales
     65  !
     66  INTEGER,SAVE,ALLOCATABLE :: ndex2d(:),ndexu(:),ndexv(:)
     67  INTEGER :: iq, ii, ll
     68  REAL,SAVE,ALLOCATABLE :: tm(:,:)
     69  REAL,SAVE,ALLOCATABLE :: vnat(:,:),unat(:,:)
     70  logical :: ok_sync
     71  integer :: itau_w
     72  integer :: ijb,ije,jjn
     73  LOGICAL,SAVE :: first=.TRUE.
    7474!$OMP THREADPRIVATE(first)
    7575
    76 C
    77 C  Initialisations
    78 C
    79       if (adjust) return
    80 
    81       IF (first) THEN
    82 !$OMP BARRIER
    83 !$OMP MASTER
    84         ALLOCATE(unat(ijb_u:ije_u,llm))
    85         ALLOCATE(vnat(ijb_v:ije_v,llm))
    86         ALLOCATE(tm(ijb_u:ije_u,llm))
    87         ALLOCATE(ndex2d(ijnb_u*llm))
    88         ALLOCATE(ndexu(ijnb_u*llm))
    89         ALLOCATE(ndexv(ijnb_v*llm))
    90         ndex2d = 0
    91         ndexu = 0
    92         ndexv = 0
    93 !$OMP END MASTER
    94 !$OMP BARRIER
    95         first=.FALSE.
    96       ENDIF
    97 
    98       ok_sync = .TRUE.
    99       itau_w = itau_dyn + time
    100 
    101 C Passage aux composantes naturelles du vent
    102       CALL covnat_loc(llm, ucov, vcov, unat, vnat)
    103 
    104 C
    105 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    106 C
    107 C  Vents U
    108 C
    109 
    110 !$OMP BARRIER
    111 !$OMP MASTER
    112       ijb=ij_begin
    113       ije=ij_end
    114       jjn=jj_nb
    115 
    116       CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:),
    117      .               iip1*jjn*llm, ndexu)
    118 !$OMP END MASTER
    119 
    120 C
    121 C  Vents V
    122 C
    123       ije=ij_end
    124       if (pole_sud) jjn=jj_nb-1
    125       if (pole_sud) ije=ij_end-iip1
    126 !$OMP BARRIER
    127 !$OMP MASTER
    128       CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:),
    129      .               iip1*jjn*llm, ndexv)
    130 !$OMP END MASTER
    131 
    132 
    133 C
    134 C  Temperature potentielle moyennee
    135 C
    136       ijb=ij_begin
    137       ije=ij_end
    138       jjn=jj_nb
    139 !$OMP MASTER
    140       CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:),
    141      .                iip1*jjn*llm, ndexu)
    142 !$OMP END MASTER
    143 
    144 C
    145 C  Temperature moyennee
    146 C
     76  !
     77  !  Initialisations
     78  !
     79  if (adjust) return
     80
     81  IF (first) THEN
     82!$OMP BARRIER
     83!$OMP MASTER
     84    ALLOCATE(unat(ijb_u:ije_u,llm))
     85    ALLOCATE(vnat(ijb_v:ije_v,llm))
     86    ALLOCATE(tm(ijb_u:ije_u,llm))
     87    ALLOCATE(ndex2d(ijnb_u*llm))
     88    ALLOCATE(ndexu(ijnb_u*llm))
     89    ALLOCATE(ndexv(ijnb_v*llm))
     90    ndex2d = 0
     91    ndexu = 0
     92    ndexv = 0
     93!$OMP END MASTER
     94!$OMP BARRIER
     95    first=.FALSE.
     96  ENDIF
     97
     98  ok_sync = .TRUE.
     99  itau_w = itau_dyn + time
     100
     101  ! Passage aux composantes naturelles du vent
     102  CALL covnat_loc(llm, ucov, vcov, unat, vnat)
     103
     104  !
     105  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     106  !
     107  !  Vents U
     108  !
     109
     110!$OMP BARRIER
     111!$OMP MASTER
     112  ijb=ij_begin
     113  ije=ij_end
     114  jjn=jj_nb
     115
     116  CALL histwrite(histuaveid, 'u', itau_w, unat(ijb:ije,:), &
     117        iip1*jjn*llm, ndexu)
     118!$OMP END MASTER
     119
     120  !
     121  !  Vents V
     122  !
     123  ije=ij_end
     124  if (pole_sud) jjn=jj_nb-1
     125  if (pole_sud) ije=ij_end-iip1
     126!$OMP BARRIER
     127!$OMP MASTER
     128  CALL histwrite(histvaveid, 'v', itau_w, vnat(ijb:ije,:), &
     129        iip1*jjn*llm, ndexv)
     130!$OMP END MASTER
     131
     132
     133  !
     134  !  Temperature potentielle moyennee
     135  !
     136  ijb=ij_begin
     137  ije=ij_end
     138  jjn=jj_nb
     139!$OMP MASTER
     140  CALL histwrite(histaveid, 'theta', itau_w, teta(ijb:ije,:), &
     141        iip1*jjn*llm, ndexu)
     142!$OMP END MASTER
     143
     144  !
     145  !  Temperature moyennee
     146  !
    147147
    148148!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
    149       do ll=1,llm
    150         do ii = ijb, ije
    151           tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
    152         enddo
    153       enddo
     149  do ll=1,llm
     150    do ii = ijb, ije
     151      tm(ii,ll) = teta(ii,ll) * ppk(ii,ll)/cpp
     152    enddo
     153  enddo
    154154!$OMP ENDDO
    155155
    156156!$OMP MASTER
    157       CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:),
    158      .                iip1*jjn*llm, ndexu)
    159 !$OMP END MASTER
    160 
    161 
    162 C
    163 C  Geopotentiel
    164 C
    165 !$OMP MASTER
    166       CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:),
    167      .                iip1*jjn*llm, ndexu)
    168 !$OMP END MASTER
    169 
    170 
    171 C
    172 C  Traceurs
    173 C
    174 !!$OMP MASTER
    175 !        DO iq=1,nqtot
    176 !          CALL histwrite(histaveid, tracers(iq)%longName, itau_w, &
    177 !    .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
    178 !        enddo
    179 !!$OMP END MASTER
    180 
    181 
    182 C
    183 C  Masse
    184 C
    185 !$OMP MASTER
    186        CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:),
    187      .                iip1*jjn*llm, ndexu)
    188 !$OMP END MASTER
    189 
    190 
    191 C
    192 C  Pression au sol
    193 C
    194 !$OMP MASTER
    195 
    196        CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije),
    197      .                 iip1*jjn, ndex2d)
    198 !$OMP END MASTER
    199 
    200 C
    201 C  Geopotentiel au sol
    202 C
    203 !$OMP MASTER
    204 !      CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
    205 !    .                 iip1*jjn, ndex2d)
    206 !$OMP END MASTER
    207 
    208 C
    209 C  Fin
    210 C
    211 !$OMP MASTER
    212       if (ok_sync) then
    213           CALL histsync(histaveid)
    214           CALL histsync(histvaveid)
    215           CALL histsync(histuaveid)
    216       ENDIF
    217 !$OMP END MASTER
    218       end
     157  CALL histwrite(histaveid, 'temp', itau_w, tm(ijb:ije,:), &
     158        iip1*jjn*llm, ndexu)
     159!$OMP END MASTER
     160
     161
     162  !
     163  !  Geopotentiel
     164  !
     165!$OMP MASTER
     166  CALL histwrite(histaveid, 'phi', itau_w, phi(ijb:ije,:), &
     167        iip1*jjn*llm, ndexu)
     168!$OMP END MASTER
     169
     170
     171  !
     172  !  Traceurs
     173  !
     174  !!$OMP MASTER
     175  !    DO iq=1,nqtot
     176  !      CALL histwrite(histaveid, tracers(iq)%longName, itau_w, &
     177  ! .                   q(ijb:ije,:,iq), iip1*jjn*llm, ndexu)
     178  !    enddo
     179  !!$OMP END MASTER
     180
     181
     182  !
     183  !  Masse
     184  !
     185!$OMP MASTER
     186   CALL histwrite(histaveid, 'masse', itau_w, masse(ijb:ije,:), &
     187         iip1*jjn*llm, ndexu)
     188!$OMP END MASTER
     189
     190
     191  !
     192  !  Pression au sol
     193  !
     194!$OMP MASTER
     195
     196   CALL histwrite(histaveid, 'ps', itau_w, ps(ijb:ije), &
     197         iip1*jjn, ndex2d)
     198!$OMP END MASTER
     199
     200  !
     201  !  Geopotentiel au sol
     202  !
     203!$OMP MASTER
     204    ! CALL histwrite(histaveid, 'phis', itau_w, phis(ijb:ije),
     205  ! .                 iip1*jjn, ndex2d)
     206!$OMP END MASTER
     207
     208  !
     209  !  Fin
     210  !
     211!$OMP MASTER
     212  if (ok_sync) then
     213      CALL histsync(histaveid)
     214      CALL histsync(histvaveid)
     215      CALL histsync(histuaveid)
     216  ENDIF
     217!$OMP END MASTER
     218end subroutine writedynav_loc
Note: See TracChangeset for help on using the changeset viewer.