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

    r5245 r5246  
    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
    66#ifdef CPP_IOIPSL
    7       USE ioipsl
     7  USE ioipsl
    88#endif
    9       USE infotrac, ONLY : nqtot
    10       use com_io_dyn_mod, only : histid,histvid,histuid
    11       USE temps_mod, ONLY: itau_dyn
    12      
    13       implicit none
     9  USE infotrac, ONLY : nqtot
     10  use com_io_dyn_mod, only : histid,histvid,histuid
     11  USE temps_mod, ONLY: itau_dyn
    1412
    15 C
    16 C   Ecriture du fichier histoire au format IOIPSL
    17 C
    18 C   Appels succesifs des routines: histwrite
    19 C
    20 C   Entree:
    21 C      time: temps de l'ecriture
    22 C      vcov: vents v covariants
    23 C      ucov: vents u covariants
    24 C      teta: temperature potentielle
    25 C      phi : geopotentiel instantane
    26 C      q   : traceurs
    27 C      masse: masse
    28 C      ps   :pression au sol
    29 C      phis : geopotentiel au sol
    30 C     
    31 C
    32 C   L. Fairhead, LMD, 03/99
    33 C
    34 C =====================================================================
    35 C
    36 C   Declarations
    37       include "dimensions.h"
    38       include "paramet.h"
    39       include "comgeom.h"
    40       include "description.h"
    41       include "iniprint.h"
     13  implicit none
    4214
    43 C
    44 C   Arguments
    45 C
     15  !
     16  !   Ecriture du fichier histoire au format IOIPSL
     17  !
     18  !   Appels succesifs des routines: histwrite
     19  !
     20  !   Entree:
     21  !  time: temps de l'ecriture
     22  !  vcov: vents v covariants
     23  !  ucov: vents u covariants
     24  !  teta: temperature potentielle
     25  !  phi : geopotentiel instantane
     26  !  q   : traceurs
     27  !  masse: masse
     28  !  ps   :pression au sol
     29  !  phis : geopotentiel au sol
     30  !
     31  !
     32  !   L. Fairhead, LMD, 03/99
     33  !
     34  ! =====================================================================
     35  !
     36  !   Declarations
     37  include "dimensions.h"
     38  include "paramet.h"
     39  include "comgeom.h"
     40  include "description.h"
     41  include "iniprint.h"
    4642
    47       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    48       REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                   
    49       REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    50       REAL phis(ip1jmp1)                 
    51       REAL q(ip1jmp1,llm,nqtot)
    52       integer time
     43  !
     44  !   Arguments
     45  !
     46
     47  REAL :: vcov(ip1jm,llm),ucov(ip1jmp1,llm)
     48  REAL :: teta(ip1jmp1,llm),phi(ip1jmp1,llm)
     49  REAL :: ps(ip1jmp1),masse(ip1jmp1,llm)
     50  REAL :: phis(ip1jmp1)
     51  REAL :: q(ip1jmp1,llm,nqtot)
     52  integer :: time
    5353
    5454
    5555#ifdef CPP_IOIPSL
    56 ! This routine needs IOIPSL to work
    57 C   Variables locales
    58 C
    59       integer iq, ii, ll
    60       integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
    61       logical ok_sync
    62       integer itau_w
    63       REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
     56  ! This routine needs IOIPSL to work
     57  !   Variables locales
     58  !
     59  integer :: iq, ii, ll
     60  integer :: ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)
     61  logical :: ok_sync
     62  integer :: itau_w
     63  REAL :: vnat(ip1jm,llm),unat(ip1jmp1,llm)
    6464
    65 C
    66 C  Initialisations
    67 C
    68       ndexu = 0
    69       ndexv = 0
    70       ndex2d = 0
    71       ok_sync =.TRUE.
    72       itau_w = itau_dyn + time
    73 !  Passage aux composantes naturelles du vent
    74       call covnat(llm, ucov, vcov, unat, vnat)
    75 C
    76 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    77 C
    78 C  Vents U
    79 C
    80       call histwrite(histuid, 'u', itau_w, unat,
    81      .               iip1*jjp1*llm, ndexu)
    82 C
    83 C  Vents V
    84 C
    85       call histwrite(histvid, 'v', itau_w, vnat,
    86      .               iip1*jjm*llm, ndexv)
     65  !
     66  !  Initialisations
     67  !
     68  ndexu = 0
     69  ndexv = 0
     70  ndex2d = 0
     71  ok_sync =.TRUE.
     72  itau_w = itau_dyn + time
     73  !  Passage aux composantes naturelles du vent
     74  call covnat(llm, ucov, vcov, unat, vnat)
     75  !
     76  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     77  !
     78  !  Vents U
     79  !
     80  call histwrite(histuid, 'u', itau_w, unat, &
     81        iip1*jjp1*llm, ndexu)
     82  !
     83  !  Vents V
     84  !
     85  call histwrite(histvid, 'v', itau_w, vnat, &
     86        iip1*jjm*llm, ndexv)
    8787
    88 C
    89 C  Temperature potentielle
    90 C
    91       call histwrite(histid, 'teta', itau_w, teta,
    92      .                iip1*jjp1*llm, ndexu)
    93 C
    94 C  Geopotentiel
    95 C
    96       call histwrite(histid, 'phi', itau_w, phi,
    97      .                iip1*jjp1*llm, ndexu)
    98 C
    99 C  Traceurs
    100 C
    101 !        DO iq=1,nqtot
    102 !          call histwrite(histid, tracers(iq)%longName, itau_w,
    103 !    .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
    104 !        enddo
    105 !C
    106 C  Masse
    107 C
    108       call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
    109 C
    110 C  Pression au sol
    111 C
    112       call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    113 C
    114 C  Geopotentiel au sol
    115 C
    116 !      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
    117 C
    118 C  Fin
    119 C
    120       if (ok_sync) then
    121         call histsync(histid)
    122         call histsync(histvid)
    123         call histsync(histuid)
    124       endif
     88  !
     89  !  Temperature potentielle
     90  !
     91  call histwrite(histid, 'teta', itau_w, teta, &
     92        iip1*jjp1*llm, ndexu)
     93  !
     94  !  Geopotentiel
     95  !
     96  call histwrite(histid, 'phi', itau_w, phi, &
     97        iip1*jjp1*llm, ndexu)
     98  !
     99  !  Traceurs
     100  !
     101  !    DO iq=1,nqtot
     102  !      call histwrite(histid, tracers(iq)%longName, itau_w,
     103  ! .                   q(:,:,iq), iip1*jjp1*llm, ndexu)
     104  !    enddo
     105  !C
     106  !  Masse
     107  !
     108  call histwrite(histid,'masse',itau_w, masse,iip1*jjp1*llm,ndexu)
     109  !
     110  !  Pression au sol
     111  !
     112  call histwrite(histid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     113  !
     114  !  Geopotentiel au sol
     115  !
     116  !  call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     117  !
     118  !  Fin
     119  !
     120  if (ok_sync) then
     121    call histsync(histid)
     122    call histsync(histvid)
     123    call histsync(histuid)
     124  endif
    125125#else
    126 ! tell the user this routine should be run with ioipsl
    127       write(lunout,*)"writehist: Warning this routine should not be",
    128      &               " used without ioipsl"
     126  ! tell the user this routine should be run with ioipsl
     127  write(lunout,*)"writehist: Warning this routine should not be", &
     128        " used without ioipsl"
    129129#endif
    130 ! of #ifdef CPP_IOIPSL
    131       return
    132       end
     130  ! of #ifdef CPP_IOIPSL
     131  return
     132end subroutine writehist
Note: See TracChangeset for help on using the changeset viewer.