trunk/dyn3d/writehist.f

module writehist_m

  implicit none

contains

  subroutine writehist(time, vcov, ucov, teta, phi, masse, ps)

    ! From writehist.F 1403 2010-07-01 09:02:53Z
    ! Écriture du fichier histoire au format IOIPSL
    ! Appels successifs des routines histwrite
    ! L. Fairhead, LMD, 03/99

    use dimens_m, only: llm
    use com_io_dyn, only: histid, histvid, histuid
    use paramet_m, only: ip1jm, ip1jmp1
    use temps, only: itau_dyn
    use histwrite_m, only: histwrite
    use histsync_m, only: histsync
    use covnat_m, only: covnat

    ! Entree:
    ! time: temps de l'ecriture
    ! vcov: vents v covariants
    ! ucov: vents u covariants
    ! teta: temperature potentielle
    ! phi : geopotentiel instantane
    ! masse: masse
    ! ps :pression au sol

    ! Arguments

    REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm) 
    REAL teta(ip1jmp1, llm), phi(ip1jmp1, llm) 
    REAL, intent(in):: ps(ip1jmp1), masse(ip1jmp1, llm) 
    integer time

    ! This routine needs IOIPSL to work
    ! Variables locales

    logical ok_sync
    integer itau_w
    REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)

    !---------------------------------------------------------------------

    ! Initialisations

    ok_sync =.TRUE.
    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(histuid, 'u', itau_w, unat)

    ! Vents V

    call histwrite(histvid, 'v', itau_w, vnat)

    ! Temperature potentielle

    call histwrite(histid, 'teta', itau_w, teta)

    ! Geopotentiel

    call histwrite(histid, 'phi', itau_w, phi)

    ! Masse

    call histwrite(histid, 'masse', itau_w, masse)

    ! Pression au sol
    call histwrite(histid, 'ps', itau_w, ps)

    if (ok_sync) then
       call histsync(histid)
       call histsync(histvid)
       call histsync(histuid)
    endif

  end subroutine writehist

end module writehist_m
1	guez	69	module writehist_m
2	guez	56
3	guez	69	implicit none
4	guez	56
5	guez	69	contains
6	guez	56
7	guez	138	subroutine writehist(time, vcov, ucov, teta, phi, masse, ps)
8	guez	56
9	guez	69	! From writehist.F 1403 2010-07-01 09:02:53Z
10			! Écriture du fichier histoire au format IOIPSL
11			! Appels successifs des routines histwrite
12			! L. Fairhead, LMD, 03/99
13	guez	56
14	guez	178	use dimens_m, only: llm
15	guez	69	use com_io_dyn, only: histid, histvid, histuid
16	guez	178	use paramet_m, only: ip1jm, ip1jmp1
17	guez	69	use temps, only: itau_dyn
18			use histwrite_m, only: histwrite
19			use histsync_m, only: histsync
20			use covnat_m, only: covnat
21	guez	56
22	guez	69	! Entree:
23			! time: temps de l'ecriture
24			! vcov: vents v covariants
25			! ucov: vents u covariants
26			! teta: temperature potentielle
27			! phi : geopotentiel instantane
28			! masse: masse
29			! ps :pression au sol
30	guez	56
31	guez	69	! Arguments
32	guez	56
33	guez	69	REAL vcov(ip1jm, llm), ucov(ip1jmp1, llm)
34			REAL teta(ip1jmp1, llm), phi(ip1jmp1, llm)
35	guez	83	REAL, intent(in):: ps(ip1jmp1), masse(ip1jmp1, llm)
36	guez	69	integer time
37	guez	56
38	guez	69	! This routine needs IOIPSL to work
39			! Variables locales
40
41			logical ok_sync
42			integer itau_w
43			REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
44
45			!---------------------------------------------------------------------
46
47			! Initialisations
48
49			ok_sync =.TRUE.
50			itau_w = itau_dyn + time
51			! Passage aux composantes naturelles du vent
52			call covnat(llm, ucov, vcov, unat, vnat)
53
54			! Appels a histwrite pour l'ecriture des variables a sauvegarder
55
56			! Vents U
57
58			call histwrite(histuid, 'u', itau_w, unat)
59
60			! Vents V
61
62			call histwrite(histvid, 'v', itau_w, vnat)
63
64			! Temperature potentielle
65
66			call histwrite(histid, 'teta', itau_w, teta)
67
68			! Geopotentiel
69
70			call histwrite(histid, 'phi', itau_w, phi)
71
72			! Masse
73
74			call histwrite(histid, 'masse', itau_w, masse)
75
76			! Pression au sol
77			call histwrite(histid, 'ps', itau_w, ps)
78
79			if (ok_sync) then
80			call histsync(histid)
81			call histsync(histvid)
82			call histsync(histuid)
83			endif
84
85			end subroutine writehist
86
87			end module writehist_m