/[lmdze]/trunk/libf/bibio/writedynav.f90
ViewVC logotype

Diff of /trunk/libf/bibio/writedynav.f90

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

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