/[lmdze]/trunk/dyn3d/writehist.f
ViewVC logotype

Diff of /trunk/dyn3d/writehist.f

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

trunk/libf/bibio/writehist.f revision 61 by guez, Fri Apr 20 14:58:43 2012 UTC trunk/dyn3d/writehist.f revision 321 by guez, Tue Dec 11 22:48:09 2018 UTC
# Line 1  Line 1 
1  !  module writehist_m
2  ! $Id: writehist.F 1403 2010-07-01 09:02:53Z fairhead $  
3  !    implicit none
4        subroutine writehist(time,vcov,ucov,teta,phi,q,masse,ps,phis)  
5    contains
6        use dimens_m, only: nqmx, llm, jjm  
7        USE iniadvtrac_m, ONLY: ttext    subroutine writehist(vcov, ucov, teta, pk, phi, q, masse, ps, itau_w)
8        use com_io_dyn, only: histid,histvid,histuid  
9        use paramet_m, only: ip1jm, ip1jmp1, iip1, jjp1      ! From writehist.F, revision 1403, 2010-07-01 09:02:53
10        use temps, only: itau_dyn      ! Écriture du fichier histoire au format IOIPSL
11        use histwrite_m, only: histwrite      ! L. Fairhead, LMD, 03/99
12        use histsync_m, only: histsync  
13        use covnat_m, only: covnat      USE comconst, ONLY: cpp
14        use covnat_m, only: covnat
15        implicit none      use dimensions, only: llm
16        use histsync_m, only: histsync
17  C      use histwrite_m, only: histwrite
18  C   Ecriture du fichier histoire au format IOIPSL      use infotrac_init_m, only: ttext
19  C      use inithist_m, only: histid, histvid, histuid
20  C   Appels succesifs des routines: histwrite      use nr_util, only: assert
21  C      use paramet_m, only: ip1jm, ip1jmp1
22  C   Entree:  
23  C      time: temps de l'ecriture      ! Vent covariant :
24  C      vcov: vents v covariants      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
25  C      ucov: vents u covariants      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
26  C      teta: temperature potentielle  
27  C      phi : geopotentiel instantane      REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
28  C      q   : traceurs      ! temperature potentielle
29  C      masse: masse  
30  C      ps   :pression au sol      real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
31  C      phis : geopotentiel au sol      real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm) ! geopotential
32  C            REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
33  C      real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
34  C   L. Fairhead, LMD, 03/99      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
35  C      integer, intent(in):: itau_w ! temps de l'ecriture
36  C =====================================================================  
37  C      ! Local:
38  C   Declarations      integer iq
39        REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
40  C  
41  C   Arguments      !---------------------------------------------------------------------
42  C  
43        call assert([size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), &
44        REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)           size(pk, 1), size(ps, 1), size(masse, 1)] == size(q, 1), &
45        REAL teta(ip1jmp1,llm),phi(ip1jmp1,llm)                             "writehist iim")
46        REAL ps(ip1jmp1),masse(ip1jmp1,llm)                        call assert([size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), &
47        REAL phis(ip1jmp1)                             size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2)] &
48        REAL q(ip1jmp1,llm,nqmx)           == size(q, 2), "writehist jjm")
49        integer time      call assert([size(vcov, 3), size(ucov, 3), size(teta, 3), size(phi, 3), &
50             size(pk, 3), size(masse, 3), size(q, 3)] == llm, "writehist llm")
51    
52  ! This routine needs IOIPSL to work      call covnat(llm, ucov, vcov, unat, vnat)
53  C   Variables locales  
54  C      call histwrite(histuid, 'u', itau_w, unat)
55        integer iq, ii, ll      call histwrite(histvid, 'v', itau_w, vnat)
56        integer ndexu(ip1jmp1*llm),ndexv(ip1jm*llm),ndex2d(ip1jmp1)      call histwrite(histid, 'theta', itau_w, teta)
57        logical ok_sync      call histwrite(histid, 'temp', itau_w, teta * pk / cpp)
58        integer itau_w      call histwrite(histid, 'phi', itau_w, phi)
59        REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)  
60        DO iq = 1, size(q, 4)
61  C         call histwrite(histid, ttext(iq), itau_w, q(:, :, :, iq))
62  C  Initialisations      enddo
63  C  
64        ndexu = 0      call histwrite(histid, 'masse', itau_w, masse)
65        ndexv = 0      call histwrite(histid, 'ps', itau_w, ps)
66        ndex2d = 0  
67        ok_sync =.TRUE.      call histsync(histid)
68        itau_w = itau_dyn + time      call histsync(histvid)
69  !  Passage aux composantes naturelles du vent      call histsync(histuid)
70        call covnat(llm, ucov, vcov, unat, vnat)  
71  C    end subroutine writehist
72  C  Appels a histwrite pour l'ecriture des variables a sauvegarder  
73  C  end module writehist_m
 C  Vents U  
 C  
       call histwrite(histuid, 'u', itau_w, unat)  
 C  
 C  Vents V  
 C  
       call histwrite(histvid, 'v', itau_w, vnat)  
   
 C  
 C  Temperature potentielle  
 C  
       call histwrite(histid, 'teta', itau_w, teta)  
 C  
 C  Geopotentiel  
 C  
       call histwrite(histid, 'phi', itau_w, phi)  
 C  
 C  Traceurs  
 C  
 !        DO iq=1,nqmx  
 !          call histwrite(histid, ttext(iq), itau_w, q(:,:,iq),  
 !     .                   iip1*jjp1*llm, ndexu)  
 !        enddo  
 !C  
 C  Masse  
 C  
       call histwrite(histid,'masse',itau_w, masse)  
 C  
 C  Pression au sol  
 C  
       call histwrite(histid, 'ps', itau_w, ps)  
 C  
 C  Geopotentiel au sol  
 C  
 !      call histwrite(histid, 'phis', itau_w, phis, iip1*jjp1, ndex2d)  
 C  
 C  Fin  
 C  
       if (ok_sync) then  
         call histsync(histid)  
         call histsync(histvid)  
         call histsync(histuid)  
       endif  
       return  
       end  
Legend:
Removed from v.61  
changed lines
  Added in v.321
  ViewVC Help
Powered by ViewVC 1.1.21