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

Contents of /trunk/dyn3d/writehist.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 328 - (show annotations)
Thu Jun 13 14:40:06 2019 UTC (4 years, 11 months ago) by guez
File size: 2510 byte(s)
Change all `.f` suffixes to `.f90`. (The opposite was done in revision
82.)  Because of change of philosopy in GNUmakefile: we already had a
rewritten rule for `.f`, so it does not make the makefile longer to
replace it by a rule for `.f90`. And it spares us options of
makedepf90 and of the compiler. Also we prepare the way for a simpler
`CMakeLists.txt`.

1 module writehist_m
2
3 implicit none
4
5 contains
6
7 subroutine writehist(vcov, ucov, teta, pk, phi, q, masse, ps, itau_w)
8
9 ! From writehist.F, revision 1403, 2010-07-01 09:02:53
10 ! Écriture du fichier histoire au format IOIPSL
11 ! L. Fairhead, LMD, 03/99
12
13 USE comconst, ONLY: cpp
14 use covnat_m, only: covnat
15 use dimensions, only: llm
16 use histsync_m, only: histsync
17 use histwrite_m, only: histwrite
18 use infotrac_init_m, only: ttext
19 use inithist_m, only: histid, histvid, histuid
20 use nr_util, only: assert
21 use paramet_m, only: ip1jm, ip1jmp1
22
23 ! Vent covariant :
24 REAL, intent(in):: vcov(:, :, :) ! (iim + 1, jjm, llm)
25 REAL, intent(in):: ucov(:, :, :) ! (iim + 1, jjm + 1, llm)
26
27 REAL, intent(in):: teta(:, :, :) ! (iim + 1, jjm + 1, llm)
28 ! temperature potentielle
29
30 real, intent(in):: pk(:, :, :) ! (iim + 1, jjm + 1, llm)
31 real, intent(in):: phi(:, :, :) ! (iim + 1, jjm + 1, llm) ! geopotential
32 REAL, intent(in):: q(:, :, :, :) ! (iim + 1, jjm + 1, llm, nqmx) traceurs
33 real, intent(in):: masse(:, :, :) ! (iim + 1, jjm + 1, llm)
34 REAL, intent(in):: ps(:, :) ! (iim + 1, jjm + 1) pression au sol
35 integer, intent(in):: itau_w ! temps de l'ecriture
36
37 ! Local:
38 integer iq
39 REAL vnat(ip1jm, llm), unat(ip1jmp1, llm)
40
41 !---------------------------------------------------------------------
42
43 call assert([size(vcov, 1), size(ucov, 1), size(teta, 1), size(phi, 1), &
44 size(pk, 1), size(ps, 1), size(masse, 1)] == size(q, 1), &
45 "writehist iim")
46 call assert([size(vcov, 2) + 1, size(ucov, 2), size(teta, 2), &
47 size(phi, 2), size(pk, 2), size(ps, 2), size(masse, 2)] &
48 == size(q, 2), "writehist jjm")
49 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 call covnat(llm, ucov, vcov, unat, vnat)
53
54 call histwrite(histuid, 'u', itau_w, unat)
55 call histwrite(histvid, 'v', itau_w, vnat)
56 call histwrite(histid, 'theta', itau_w, teta)
57 call histwrite(histid, 'temp', itau_w, teta * pk / cpp)
58 call histwrite(histid, 'phi', itau_w, phi)
59
60 DO iq = 1, size(q, 4)
61 call histwrite(histid, ttext(iq), itau_w, q(:, :, :, iq))
62 enddo
63
64 call histwrite(histid, 'masse', itau_w, masse)
65 call histwrite(histid, 'ps', itau_w, ps)
66
67 call histsync(histid)
68 call histsync(histvid)
69 call histsync(histuid)
70
71 end subroutine writehist
72
73 end module writehist_m

  ViewVC Help
Powered by ViewVC 1.1.21