Changeset 1612 for LMDZ5/trunk/libf/bibio

Timestamp:

Jan 31, 2012, 11:11:48 AM (13 years ago)

Author:

lguez

Message:

Conversion to free source form.

File:

• LMDZ5/trunk/libf/bibio/writedynav.F90 (moved) (moved from LMDZ5/trunk/libf/bibio/writedynav.F) (1 diff)

LMDZ5/trunk/libf/bibio/writedynav.F90

@@ -1 @@
-!
 ! $Id$
-!
-      subroutine writedynav(time, vcov, 
-     ,                ucov,teta,ppk,phi,q,masse,ps,phis)
+
+subroutine writedynav(time, vcov, ucov, teta, ppk, phi, q, masse, ps, phis)
 
 #ifdef CPP_IOIPSL
-      USE ioipsl
+  USE ioipsl
 #endif
-      USE infotrac, ONLY : nqtot, ttext
-      use com_io_dyn_mod, only : histaveid,histvaveid,histuaveid
-      implicit none
+  USE infotrac, ONLY : nqtot, ttext
+  use com_io_dyn_mod, only : histaveid, histvaveid, histuaveid
 
-C
-C   Ecriture du fichier histoire au format IOIPSL
-C
-C   Appels succesifs des routines: histwrite
-C
-C   Entree:
-C      time: temps de l'ecriture
-C      vcov: vents v covariants
-C      ucov: vents u covariants
-C      teta: temperature potentielle
-C      phi : geopotentiel instantane
-C      q   : traceurs
-C      masse: masse
-C      ps   :pression au sol
-C      phis : geopotentiel au sol
-C      
-C
-C
-C   L. Fairhead, LMD, 03/99
-C
-C =====================================================================
-C
-C   Declarations
-#include "dimensions.h"
-#include "paramet.h"
-#include "comconst.h"
-#include "comvert.h"
-#include "comgeom.h"
-#include "temps.h"
-#include "ener.h"
-#include "logic.h"
-#include "description.h"
-#include "serre.h"
-#include "iniprint.h"
+  implicit none
 
-C
-C   Arguments
-C
+  !   Ecriture du fichier histoire au format IOIPSL
 
-      REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm) 
-      REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)     
-      REAL ps(ip1jmp1),masse(ip1jmp1,llm)                   
-      REAL phis(ip1jmp1)                  
-      REAL q(ip1jmp1,llm,nqtot)
-      integer time
+  !   Appels succesifs des routines: histwrite
 
+  !   Entree:
+  !      time: temps de l'ecriture
+  !      vcov: vents v covariants
+  !      ucov: vents u covariants
+  !      teta: temperature potentielle
+  !      phi : geopotentiel instantane
+  !      q   : traceurs
+  !      masse: masse
+  !      ps   :pression au sol
+  !      phis : geopotentiel au sol
+
+  !   L. Fairhead, LMD, 03/99
+
+  !   Declarations
+  include "dimensions.h"
+  include "paramet.h"
+  include "comconst.h"
+  include "comvert.h"
+  include "comgeom.h"
+  include "temps.h"
+  include "ener.h"
+  include "logic.h"
+  include "description.h"
+  include "serre.h"
+  include "iniprint.h"
+
+  !   Arguments
+
+  REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) 
+  REAL teta(ip1jmp1*llm), phi(ip1jmp1, llm), ppk(ip1jmp1*llm)     
+  REAL ps(ip1jmp1), masse(ip1jmp1, llm)                   
+  REAL phis(ip1jmp1)                  
+  REAL q(ip1jmp1, llm, nqtot)
+  integer time
 
 #ifdef CPP_IOIPSL
-! This routine needs IOIPSL to work
-C   Variables locales
-C
-      integer ndex2d(ip1jmp1),ndexu(ip1jmp1*llm),ndexv(ip1jm*llm)
-      INTEGER iq, ii, ll
-      real tm(ip1jmp1*llm)
-      REAL vnat(ip1jm,llm),unat(ip1jmp1,llm) 
-      logical ok_sync
-      integer itau_w
-C
-C  Initialisations
-C
-      ndexu = 0
-      ndexv = 0
-      ndex2d = 0
-      ok_sync = .TRUE.
-      tm = 999.999
-      vnat = 999.999
-      unat = 999.999
-      itau_w = itau_dyn + time
+  ! This routine needs IOIPSL to work
+  !   Variables locales
 
-C Passage aux composantes naturelles du vent
-      call covnat(llm, ucov, vcov, unat, vnat)
+  integer ndex2d(ip1jmp1), ndexu(ip1jmp1*llm), ndexv(ip1jm*llm)
+  INTEGER iq, ii, ll
+  real tm(ip1jmp1*llm)
+  REAL vnat(ip1jm, llm), unat(ip1jmp1, llm) 
+  logical ok_sync
+  integer itau_w
 
-C
-C  Appels a histwrite pour l'ecriture des variables a sauvegarder
-C
-C  Vents U 
-C
-      call histwrite(histuaveid, 'u', itau_w, unat, 
-     .               iip1*jjp1*llm, ndexu)
-C
-C  Vents V
-C
-      call histwrite(histvaveid, 'v', itau_w, vnat, 
-     .               iip1*jjm*llm, ndexv)
-C
-C  Temperature potentielle moyennee
-C
-      call histwrite(histaveid, 'theta', itau_w, teta, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Temperature moyennee
-C
-      do ii = 1, ijp1llm
-        tm(ii) = teta(ii) * ppk(ii)/cpp
-      enddo
-      call histwrite(histaveid, 'temp', itau_w, tm, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Geopotentiel
-C
-      call histwrite(histaveid, 'phi', itau_w, phi, 
-     .                iip1*jjp1*llm, ndexu)
-C
-C  Traceurs
-C
-!        DO iq=1,nqtot
-!          call histwrite(histaveid, ttext(iq), itau_w, q(:,:,iq), 
-!     .                   iip1*jjp1*llm, ndexu)
-!        enddo
-C
-C  Masse
-C
-       call histwrite(histaveid, 'masse', itau_w, masse, 
-     $                   iip1*jjp1*llm, ndexu)
-C
-C  Pression au sol
-C
-       call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
-C
-C  Geopotentiel au sol
-C
-!       call histwrite(histaveid,'phis',itau_w, phis,iip1*jjp1, ndex2d)
-C
-C  Fin
-C
-      if (ok_sync) then
-          call histsync(histaveid)
-          call histsync(histvaveid)
-          call histsync(histuaveid)
-      ENDIF
+  !-----------------------------------------------------------------
+
+  !  Initialisations
+
+  ndexu = 0
+  ndexv = 0
+  ndex2d = 0
+  ok_sync = .TRUE.
+  tm = 999.999
+  vnat = 999.999
+  unat = 999.999
+  itau_w = itau_dyn + time
+
+  ! Passage aux composantes naturelles du vent
+  call covnat(llm, ucov, vcov, unat, vnat)
+
+  !  Appels a histwrite pour l'ecriture des variables a sauvegarder
+
+  !  Vents U 
+
+  call histwrite(histuaveid, 'u', itau_w, unat,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Vents V
+
+  call histwrite(histvaveid, 'v', itau_w, vnat,  &
+       iip1*jjm*llm, ndexv)
+
+  !  Temperature potentielle moyennee
+
+  call histwrite(histaveid, 'theta', itau_w, teta,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Temperature moyennee
+
+  do ii = 1, ijp1llm
+     tm(ii) = teta(ii) * ppk(ii)/cpp
+  enddo
+  call histwrite(histaveid, 'temp', itau_w, tm,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Geopotentiel
+
+  call histwrite(histaveid, 'phi', itau_w, phi,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Traceurs
+
+  !  DO iq=1, nqtot
+  !       call histwrite(histaveid, ttext(iq), itau_w, q(:, :, iq), &
+  !                   iip1*jjp1*llm, ndexu)
+  ! enddo
+
+  !  Masse
+
+  call histwrite(histaveid, 'masse', itau_w, masse,  &
+       iip1*jjp1*llm, ndexu)
+
+  !  Pression au sol
+
+  call histwrite(histaveid, 'ps', itau_w, ps, iip1*jjp1, ndex2d)
+
+  ! Geopotentiel au sol
+
+  ! call histwrite(histaveid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)
+
+  if (ok_sync) then
+     call histsync(histaveid)
+     call histsync(histvaveid)
+     call histsync(histuaveid)
+  ENDIF
 
 #else
-! tell the user this routine should be run with ioipsl
-      write(lunout,*)"writedynav: Warning this routine should not be",
-     &               " used without ioipsl"
+  write(lunout, *) "writedynav: Warning this routine should not be", &
+       " used without ioipsl"
 #endif
-! of #ifdef CPP_IOIPSL
-      return
-      end
+  ! of #ifdef CPP_IOIPSL
+
+end subroutine writedynav