Ignore:
Timestamp:
Jul 23, 2024, 7:14:34 PM (8 weeks 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/dyn3d_common/writehist.f90

    r5104 r5105  
    22! $Id$
    33
    4       SUBROUTINE writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
     4SUBROUTINE writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)
    55
    6       USE ioipsl
    7       USE infotrac, ONLY: nqtot
    8       use com_io_dyn_mod, ONLY: histid,histvid,histuid
    9       USE temps_mod, ONLY: itau_dyn
    10      
    11       implicit none
     6  USE ioipsl
     7  USE infotrac, ONLY: nqtot
     8  use com_io_dyn_mod, ONLY: histid,histvid,histuid
     9  USE temps_mod, ONLY: itau_dyn
    1210
    13 C
    14 C   Ecriture du fichier histoire au format IOIPSL
    15 C
    16 C   Appels succesifs des routines: histwrite
    17 C
    18 C   Entree:
    19 C      time: temps de l'ecriture
    20 C      vcov: vents v covariants
    21 C      ucov: vents u covariants
    22 C      teta: temperature potentielle
    23 C      phi : geopotentiel instantane
    24 C      q   : traceurs
    25 C      masse: masse
    26 C      ps   :pression au sol
    27 C      phis : geopotentiel au sol
    28 C     
    29 C
    30 C   L. Fairhead, LMD, 03/99
    31 C
    32 C =====================================================================
    33 C
    34 C   Declarations
    35       include "dimensions.h"
    36       include "paramet.h"
    37       include "comgeom.h"
    38       include "description.h"
    39       include "iniprint.h"
     11  implicit none
    4012
    41 C
    42 C   Arguments
    43 C
     13  !
     14  !   Ecriture du fichier histoire au format IOIPSL
     15  !
     16  !   Appels succesifs des routines: histwrite
     17  !
     18  !   Entree:
     19  !  time: temps de l'ecriture
     20  !  vcov: vents v covariants
     21  !  ucov: vents u covariants
     22  !  teta: temperature potentielle
     23  !  phi : geopotentiel instantane
     24  !  q   : traceurs
     25  !  masse: masse
     26  !  ps   :pression au sol
     27  !  phis : geopotentiel au sol
     28  !
     29  !
     30  !   L. Fairhead, LMD, 03/99
     31  !
     32  ! =====================================================================
     33  !
     34  !   Declarations
     35  include "dimensions.h"
     36  include "paramet.h"
     37  include "comgeom.h"
     38  include "description.h"
     39  include "iniprint.h"
    4440
    45       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    46       REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    47       REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    48       REAL phis(ip1jmp1)                 
    49       REAL q(ip1jmp1,llm,nqtot)
    50       integer time
     41  !
     42  !   Arguments
     43  !
     44
     45  REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm)
     46  REAL :: teta(ip1jmp1,llm),phi(ip1jmp1,llm)
     47  REAL :: ps(ip1jmp1),masse(ip1jmp1,llm)
     48  REAL :: phis(ip1jmp1)
     49  REAL :: q(ip1jmp1,llm,nqtot)
     50  integer :: time
    5151
    5252
    53 ! This routine needs IOIPSL to work
    54 C   Variables locales
    55 C
    56       integer iq, ii, ll
    57       integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
    58       logical ok_sync
    59       integer itau_w
    60       REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
     53  ! This routine needs IOIPSL to work
     54  !   Variables locales
     55  !
     56  integer :: iq, ii, ll
     57  integer :: ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
     58  logical :: ok_sync
     59  integer :: itau_w
     60  REAL :: vnat(ip1jm,llm),unat(ip1jmp1,llm)
    6161
    62 C
    63 C  Initialisations
    64 C
    65       ndexu = 0
    66       ndexv = 0
    67       ndex2d = 0
    68       ok_sync =.TRUE.
    69       itau_w = itau_dyn + time
    70 !  Passage aux composantes naturelles du vent
    71       CALL covnat(llm, ucov, vcov, unat, vnat)
    72 C
    73 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    74 C
    75 C  Vents U
    76 C
    77       CALL histwrite(histuid, 'u', itau_w, unat,
    78      .               iip1*jjp1*llm, ndexu)
    79 C
    80 C  Vents V
    81 C
    82       CALL histwrite(histvid, 'v', itau_w, vnat,
    83      .               iip1*jjm*llm, ndexv)
     62  !
     63  !  Initialisations
     64  !
     65  ndexu = 0
     66  ndexv = 0
     67  ndex2d = 0
     68  ok_sync =.TRUE.
     69  itau_w = itau_dyn + time
     70  !  Passage aux composantes naturelles du vent
     71  CALL covnat(llm, ucov, vcov, unat, vnat)
     72  !
     73  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     74  !
     75  !  Vents U
     76  !
     77  CALL histwrite(histuid, 'u', itau_w, unat, &
     78        iip1*jjp1*llm, ndexu)
     79  !
     80  !  Vents V
     81  !
     82  CALL histwrite(histvid, 'v', itau_w, vnat, &
     83        iip1*jjm*llm, ndexv)
    8484
    85 C
    86 C  Temperature potentielle
    87 C
    88       CALL histwrite(histid, 'teta', itau_w, teta,
    89      .                iip1*jjp1*llm, ndexu)
    90 C
    91 C  Geopotentiel
    92 C
    93       CALL histwrite(histid, 'phi', itau_w, phi,
    94      .                iip1*jjp1*llm, ndexu)
    95 C
    96 C  Traceurs
    97 C
    98 !        DO iq=1,nqtot
    99 !          CALL histwrite(histid, tracers(iq)%longName, itau_w,
    100 !    .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
    101 !        enddo
    102 !C
    103 C  Masse
    104 C
    105       CALL histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
    106 C
    107 C  Pression au sol
    108 C
    109       CALL histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    110 C
    111 C  Geopotentiel au sol
    112 C
    113 !      CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    114 C
    115 C  Fin
    116 C
    117       if (ok_sync) then
    118         CALL histsync(histid)
    119         CALL histsync(histvid)
    120         CALL histsync(histuid)
    121       endif
    122       return
    123       end
     85  !
     86  !  Temperature potentielle
     87  !
     88  CALL histwrite(histid, 'teta', itau_w, teta, &
     89        iip1*jjp1*llm, ndexu)
     90  !
     91  !  Geopotentiel
     92  !
     93  CALL histwrite(histid, 'phi', itau_w, phi, &
     94        iip1*jjp1*llm, ndexu)
     95  !
     96  !  Traceurs
     97  !
     98  !    DO iq=1,nqtot
     99  !      CALL histwrite(histid, tracers(iq)%longName, itau_w,
     100  ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
     101  !    enddo
     102  !C
     103  !  Masse
     104  !
     105  CALL histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
     106  !
     107  !  Pression au sol
     108  !
     109  CALL histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     110  !
     111  !  Geopotentiel au sol
     112  !
     113  !  CALL histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     114  !
     115  !  Fin
     116  !
     117  if (ok_sync) then
     118    CALL histsync(histid)
     119    CALL histsync(histvid)
     120    CALL histsync(histuid)
     121  endif
     122  return
     123end subroutine writehist
Note: See TracChangeset for help on using the changeset viewer.