Changeset 1612


Ignore:
Timestamp:
Jan 31, 2012, 11:11:48 AM (13 years ago)
Author:
lguez
Message:

Conversion to free source form.

File:
1 moved

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/bibio/writedynav.F90

    r1611 r1612  
    1 !
    21! $Id$
    3 !
    4       subroutine writedynav(time, vcov,
    5      ,                ucov,teta,ppk,phi,q,masse,ps,phis)
     2
     3subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
    64
    75#ifdef CPP_IOIPSL
    8       USE ioipsl
     6  USE ioipsl
    97#endif
    10       USE infotrac, ONLY : nqtot, ttext
    11       use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
    12       implicit none
     8  USE infotrac, ONLY : nqtot, ttext
     9  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
    1310
    14 C
    15 C   Ecriture du fichier histoire au format IOIPSL
    16 C
    17 C   Appels succesifs des routines: histwrite
    18 C
    19 C   Entree:
    20 C      time: temps de l'ecriture
    21 C      vcov: vents v covariants
    22 C      ucov: vents u covariants
    23 C      teta: temperature potentielle
    24 C      phi : geopotentiel instantane
    25 C      q   : traceurs
    26 C      masse: masse
    27 C      ps   :pression au sol
    28 C      phis : geopotentiel au sol
    29 C     
    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 "comconst.h"
    40 #include "comvert.h"
    41 #include "comgeom.h"
    42 #include "temps.h"
    43 #include "ener.h"
    44 #include "logic.h"
    45 #include "description.h"
    46 #include "serre.h"
    47 #include "iniprint.h"
     11  implicit none
    4812
    49 C
    50 C   Arguments
    51 C
     13  !   Ecriture du fichier histoire au format IOIPSL
    5214
    53       REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)
    54       REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)     
    55       REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
    56       REAL phis(ip1jmp1)                 
    57       REAL q(ip1jmp1,llm,nqtot)
    58       integer time
     15  !   Appels succesifs des routines: histwrite
    5916
     17  !   Entree:
     18  !      time: temps de l'ecriture
     19  !      vcov: vents v covariants
     20  !      ucov: vents u covariants
     21  !      teta: temperature potentielle
     22  !      phi : geopotentiel instantane
     23  !      q   : traceurs
     24  !      masse: masse
     25  !      ps   :pression au sol
     26  !      phis : geopotentiel au sol
     27
     28  !   L. Fairhead, LMD, 03/99
     29
     30  !   Declarations
     31  include "dimensions.h"
     32  include "paramet.h"
     33  include "comconst.h"
     34  include "comvert.h"
     35  include "comgeom.h"
     36  include "temps.h"
     37  include "ener.h"
     38  include "logic.h"
     39  include "description.h"
     40  include "serre.h"
     41  include "iniprint.h"
     42
     43  !   Arguments
     44
     45  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
     46  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)     
     47  REAL ps(ip1jmp1), masse(ip1jmp1, llm)                   
     48  REAL phis(ip1jmp1)                 
     49  REAL q(ip1jmp1, llm, nqtot)
     50  integer time
    6051
    6152#ifdef CPP_IOIPSL
    62 ! This routine needs IOIPSL to work
    63 C   Variables locales
    64 C
    65       integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm)
    66       INTEGER iq, ii, ll
    67       real tm(ip1jmp1*llm)
    68       REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)
    69       logical ok_sync
    70       integer itau_w
    71 C
    72 C  Initialisations
    73 C
    74       ndexu = 0
    75       ndexv = 0
    76       ndex2d = 0
    77       ok_sync = .TRUE.
    78       tm = 999.999
    79       vnat = 999.999
    80       unat = 999.999
    81       itau_w = itau_dyn + time
     53  ! This routine needs IOIPSL to work
     54  !   Variables locales
    8255
    83 C Passage aux composantes naturelles du vent
    84       call covnat(llm, ucov, vcov, unat, vnat)
     56  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
     57  INTEGER iq, ii, ll
     58  real tm(ip1jmp1*llm)
     59  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
     60  logical ok_sync
     61  integer itau_w
    8562
    86 C
    87 C  Appels a histwrite pour l'ecriture des variables a sauvegarder
    88 C
    89 C  Vents U
    90 C
    91       call histwrite(histuaveid, 'u', itau_w, unat,
    92      .               iip1*jjp1*llm, ndexu)
    93 C
    94 C  Vents V
    95 C
    96       call histwrite(histvaveid, 'v', itau_w, vnat,
    97      .               iip1*jjm*llm, ndexv)
    98 C
    99 C  Temperature potentielle moyennee
    100 C
    101       call histwrite(histaveid, 'theta', itau_w, teta,
    102      .                iip1*jjp1*llm, ndexu)
    103 C
    104 C  Temperature moyennee
    105 C
    106       do ii = 1, ijp1llm
    107         tm(ii) = teta(ii) * ppk(ii)/cpp
    108       enddo
    109       call histwrite(histaveid, 'temp', itau_w, tm,
    110      .                iip1*jjp1*llm, ndexu)
    111 C
    112 C  Geopotentiel
    113 C
    114       call histwrite(histaveid, 'phi', itau_w, phi,
    115      .                iip1*jjp1*llm, ndexu)
    116 C
    117 C  Traceurs
    118 C
    119 !        DO iq=1,nqtot
    120 !          call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq),
    121 !     .                   iip1*jjp1*llm, ndexu)
    122 !        enddo
    123 C
    124 C  Masse
    125 C
    126        call histwrite(histaveid, 'masse', itau_w, masse,
    127      $                   iip1*jjp1*llm, ndexu)
    128 C
    129 C  Pression au sol
    130 C
    131        call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
    132 C
    133 C  Geopotentiel au sol
    134 C
    135 !       call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d)
    136 C
    137 C  Fin
    138 C
    139       if (ok_sync) then
    140           call histsync(histaveid)
    141           call histsync(histvaveid)
    142           call histsync(histuaveid)
    143       ENDIF
     63  !-----------------------------------------------------------------
     64
     65  !  Initialisations
     66
     67  ndexu = 0
     68  ndexv = 0
     69  ndex2d = 0
     70  ok_sync = .TRUE.
     71  tm = 999.999
     72  vnat = 999.999
     73  unat = 999.999
     74  itau_w = itau_dyn + time
     75
     76  ! Passage aux composantes naturelles du vent
     77  call covnat(llm, ucov, vcov, unat, vnat)
     78
     79  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
     80
     81  !  Vents U
     82
     83  call histwrite(histuaveid, 'u', itau_w, unat,  &
     84       iip1*jjp1*llm, ndexu)
     85
     86  !  Vents V
     87
     88  call histwrite(histvaveid, 'v', itau_w, vnat,  &
     89       iip1*jjm*llm, ndexv)
     90
     91  !  Temperature potentielle moyennee
     92
     93  call histwrite(histaveid, 'theta', itau_w, teta,  &
     94       iip1*jjp1*llm, ndexu)
     95
     96  !  Temperature moyennee
     97
     98  do ii = 1, ijp1llm
     99     tm(ii) = teta(ii) * ppk(ii)/cpp
     100  enddo
     101  call histwrite(histaveid, 'temp', itau_w, tm,  &
     102       iip1*jjp1*llm, ndexu)
     103
     104  !  Geopotentiel
     105
     106  call histwrite(histaveid, 'phi', itau_w, phi,  &
     107       iip1*jjp1*llm, ndexu)
     108
     109  !  Traceurs
     110
     111  !  DO iq=1, nqtot
     112  !       call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
     113  !                   iip1*jjp1*llm, ndexu)
     114  ! enddo
     115
     116  !  Masse
     117
     118  call histwrite(histaveid, 'masse', itau_w, masse,  &
     119       iip1*jjp1*llm, ndexu)
     120
     121  !  Pression au sol
     122
     123  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
     124
     125  ! Geopotentiel au sol
     126
     127  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
     128
     129  if (ok_sync) then
     130     call histsync(histaveid)
     131     call histsync(histvaveid)
     132     call histsync(histuaveid)
     133  ENDIF
    144134
    145135#else
    146 ! tell the user this routine should be run with ioipsl
    147       write(lunout,*)"writedynav: Warning this routine should not be",
    148      &               " used without ioipsl"
     136  write(lunout, *) "writedynav: Warning this routine should not be", &
     137       " used without ioipsl"
    149138#endif
    150 ! of #ifdef CPP_IOIPSL
    151       return
    152       end
     139  ! of #ifdef CPP_IOIPSL
     140
     141end subroutine writedynav
Note: See TracChangeset for help on using the changeset viewer.