/[lmdze]/trunk/Sources/dyn3d/writedynav.f
ViewVC logotype

Diff of /trunk/Sources/dyn3d/writedynav.f

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

trunk/libf/bibio/writedynav.f revision 15 by guez, Fri Aug 1 15:24:12 2008 UTC trunk/Sources/bibio/writedynav.f revision 134 by guez, Wed Apr 29 15:47:56 2015 UTC
# Line 1  Line 1 
1  !  module writedynav_m
2  ! $Header: /home/cvsroot/LMDZ4/libf/bibio/writedynav.F,v 1.1.1.1 2004/05/19 12:53:05 lmdzadmin Exp $  
3  !    implicit none
4        subroutine writedynav( histid, nq, time, vcov,  
5       ,                          ucov,teta,ppk,phi,q,masse,ps,phis)  contains
6    
7        USE ioipsl    subroutine writedynav(vcov, ucov, teta, pk, phi, q, masse, ps, phis, time)
8  C  
9  C   Ecriture du fichier histoire au format IOIPSL      ! From LMDZ4/libf/bibio/writedynav.F, version 1.1.1.1 2004/05/19 12:53:05
10  C      ! Écriture du fichier histoire au format IOIPSL
11  C   Appels succesifs des routines: histwrite      ! L. Fairhead, LMD, 03/99
12  C  
13  C   Entree:      ! Appels successifs des routines histwrite
14  C      histid: ID du fichier histoire  
15  C      time: temps de l'ecriture      USE comconst, ONLY: cpp
16  C      vcov: vents v covariants      use covnat_m, only: covnat
17  C      ucov: vents u covariants      USE dimens_m, ONLY: iim, jjm, llm, nqmx
18  C      teta: temperature potentielle      USE histsync_m, ONLY: histsync
19  C      phi : geopotentiel instantane      USE histwrite_m, ONLY: histwrite
20  C      q   : traceurs      USE iniadvtrac_m, ONLY: ttext
21  C      masse: masse      use initdynav_m, only: histaveid
22  C      ps   :pression au sol      use nr_util, only: assert
23  C      phis : geopotentiel au sol      USE paramet_m, ONLY: iip1, ip1jm, ip1jmp1, jjp1
24  C            USE temps, ONLY: itau_dyn
25  C  
26  C   Sortie:      ! Vents covariants :
27  C      fileid: ID du fichier netcdf cree      REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
28  C      REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
29  C   L. Fairhead, LMD, 03/99  
30  C      REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
31  C =====================================================================      ! temperature potentielle
32  C  
33  C   Declarations      real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
34        use dimens_m  
35        use paramet_m      real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm)
36        use comconst      ! geopotentiel instantane
37        use comvert  
38        use logic      REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
39        use comgeom      real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
40        use serre      REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
41        use temps      REAL, intent(in):: phis(:, :) ! (iim + 1, jjm + 1) geopotentiel au sol
42        use ener      integer, intent(in):: time ! temps de l'ecriture
43        use advtrac_m  
44        implicit none      ! Variables locales
45        integer iq
46        real us(ip1jmp1*llm), vs(ip1jmp1*llm)
47  C      REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
48  C   Arguments      integer itau_w
49  C  
50        !---------------------------------------------------------------
51        INTEGER histid, nq  
52        REAL vcov(ip1jm,llm),ucov(ip1jmp1,llm)      call assert((/size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), &
53        REAL teta(ip1jmp1*llm),phi(ip1jmp1,llm),ppk(ip1jmp1*llm)                             size(pk, 1), size(ps, 1), size(masse, 1), size(phis, 1), &
54        REAL ps(ip1jmp1),masse(ip1jmp1,llm)                             size(q, 1)/) == iim + 1, "writedynav iim")
55        REAL phis(ip1jmp1)                        call assert((/size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), &
56        REAL q(ip1jmp1,llm,nq)           size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2), &
57        integer, intent(in):: time           size(phis, 2), size(q, 2)/) == jjm + 1, "writedynav jjm")
58        call assert((/size(vcov, 3), size(ucov, 3), size(teta, 3), size(phi, 3), &
59             size(pk, 3), size(masse, 3), size(q, 3)/) == llm, "writedynav llm")
60  C   Variables locales      call assert(size(q, 4) == nqmx, "writedynav nqmx")
61  C  
62        integer ndex2d(iip1*jjp1),ndex3d(iip1*jjp1*llm),iq, ii, ll      ! Initialisations
63        real us(ip1jmp1*llm), vs(ip1jmp1*llm)      us = 999.999
64        real tm(ip1jmp1*llm)      vs = 999.999
65        REAL vnat(ip1jm,llm),unat(ip1jmp1,llm)      vnat = 999.999
66        logical ok_sync      unat = 999.999
67        integer itau_w      itau_w = itau_dyn + time
68  C  
69  C  Initialisations      ! Passage aux composantes naturelles du vent
70  C      call covnat(llm, ucov, vcov, unat, vnat)
71        ndex3d = 0  
72        ndex2d = 0      ! Appels a histwrite pour l'ecriture des variables a sauvegarder
73        ok_sync = .TRUE.  
74        us = 999.999      ! Vents U scalaire
75        vs = 999.999      call gr_u_scal(llm, unat, us)
76        tm = 999.999      call histwrite(histaveid, 'u', itau_w, us)
77        vnat = 999.999  
78        unat = 999.999      ! Vents V scalaire
79        itau_w = itau_dyn + time      call gr_v_scal(llm, vnat, vs)
80        call histwrite(histaveid, 'v', itau_w, vs)
81  C Passage aux composantes naturelles du vent  
82        call covnat(llm, ucov, vcov, unat, vnat)      ! Temperature potentielle moyennee
83        call histwrite(histaveid, 'theta', itau_w, teta)
84  C  
85  C  Appels a histwrite pour l'ecriture des variables a sauvegarder      ! Temperature moyennee
86  C      call histwrite(histaveid, 'temp', itau_w, teta * pk / cpp)
87  C  Vents U scalaire  
88  C      call histwrite(histaveid, 'phi', itau_w, phi)
89        call gr_u_scal(llm, unat, us)  
90        call histwrite(histid, 'u', itau_w, us)      ! Traceurs
91  C      DO iq = 1, size(q, 4)
92  C  Vents V scalaire         call histwrite(histaveid, ttext(iq), itau_w, q(:, :, :, iq))
93  C      enddo
94        call gr_v_scal(llm, vnat, vs)  
95        call histwrite(histid, 'v', itau_w, vs)      call histwrite(histaveid, 'masse', itau_w, masse)
96  C      call histwrite(histaveid, 'ps', itau_w, ps)
97  C  Temperature potentielle moyennee      call histwrite(histaveid, 'phis', itau_w, phis)
98  C  
99        call histwrite(histid, 'theta', itau_w, teta)      call histsync(histaveid)
100  C  
101  C  Temperature moyennee    end subroutine writedynav
102  C  
103        do ii = 1, ijp1llm  end module writedynav_m
         tm(ii) = teta(ii) * ppk(ii)/cpp  
       enddo  
       call histwrite(histid, 'temp', itau_w, tm)  
 C  
 C  Geopotentiel  
 C  
       call histwrite(histid, 'phi', itau_w, phi)  
 C  
 C  Traceurs  
 C  
         DO iq=1,nq  
           call histwrite(histid, ttext(iq), itau_w, q(:,:,iq))  
         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)  
 C  
 C  Fin  
 C  
       if (ok_sync) call histsync(histid)  
       return  
       end  
Legend:
Removed from v.15  
changed lines
  Added in v.134
  ViewVC Help
Powered by ViewVC 1.1.21