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

Annotation of /trunk/dyn3d/dynredem1.f

Parent Directory Parent Directory | Revision Log Revision Log


Revision 5 - (hide annotations)
Mon Mar 3 16:32:04 2008 UTC (16 years, 2 months ago) by guez
Original Path: trunk/libf/dyn3d/dynredem1.f90
File size: 3236 byte(s)
Created module from included file parafilt.
Converted caldyn0 to free format.
Added a rule to create cross-references with NAG.
Added optional attribute in iniadvtrac.
Suppressed argument nq in dynredem0 and dynredem1, using nqmx instead.
Replaced some NetCDF calls by netcdf95 calls in dynredem0.
Added intent attribute in dynredem0 and dynredem1.
Annotated use statements with only clause, in dynredem1.
Suppressed variable nq and argument of iniadvtrac in etat0.
Added test on nqmx in etat0.
1 guez 5 SUBROUTINE dynredem1(fichnom, time, vcov, ucov, teta, q, masse, ps)
2 guez 3
3 guez 5 ! From dyn3d/dynredem.F, v 1.2 2004/06/22 11:45:30
4 guez 3
5 guez 5 ! Ecriture du fichier de redémarrage au format NetCDF
6 guez 3
7 guez 5 USE dimens_m, ONLY : llm, nqmx
8     USE paramet_m, ONLY : ip1jm, ip1jmp1
9     USE temps, ONLY : itaufin, itau_dyn
10     USE abort_gcm_m, ONLY : abort_gcm
11     USE advtrac_m, ONLY : tname
12 guez 3
13     IMPLICIT NONE
14    
15 guez 5 REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
16     REAL, INTENT (IN) :: ps(ip1jmp1), masse(ip1jmp1, llm)
17     REAL, INTENT (IN) :: q(ip1jmp1, llm, nqmx)
18     CHARACTER(len=*), INTENT (IN) :: fichnom
19 guez 3
20 guez 5 INCLUDE 'netcdf.inc'
21 guez 3
22 guez 5 REAL :: time
23     INTEGER :: nid, nvarid
24     INTEGER :: ierr
25     INTEGER :: iq
26     INTEGER :: length
27     PARAMETER (length=100)
28     REAL :: tab_cntrl(length) ! tableau des parametres du run
29     CHARACTER (len=20) :: modname
30     CHARACTER (len=80) :: abort_message
31     INTEGER :: nb = 0
32 guez 3
33     !---------------------------------------------------------
34    
35 guez 5 PRINT *, 'Call sequence information: dynredem1'
36 guez 3
37     modname = 'dynredem1'
38 guez 5 ierr = nf_open(fichnom, nf_write, nid)
39     IF (ierr/=nf_noerr) THEN
40     PRINT *, 'Pb. d ouverture ' // fichnom
41     STOP 1
42     END IF
43 guez 3
44     ! Ecriture/extension de la coordonnee temps
45    
46     nb = nb + 1
47 guez 5 ierr = nf_inq_varid(nid, 'temps', nvarid)
48     IF (ierr/=nf_noerr) THEN
49     PRINT *, nf_strerror(ierr)
50     abort_message = 'Variable temps n est pas definie'
51     CALL abort_gcm(modname, abort_message, ierr)
52     END IF
53     ierr = nf_put_var1_real(nid, nvarid, nb, time)
54     PRINT *, 'Enregistrement pour ', nb, time
55 guez 3
56 guez 5
57 guez 3 ! Re-ecriture du tableau de controle, itaufin n'est plus defini quand
58     ! on passe dans dynredem0
59 guez 5 ierr = nf_inq_varid(nid, 'controle', nvarid)
60     IF (ierr/=nf_noerr) THEN
61     abort_message = 'dynredem1: Le champ <controle> est absent'
62 guez 3 ierr = 1
63 guez 5 CALL abort_gcm(modname, abort_message, ierr)
64     END IF
65     ierr = nf_get_var_real(nid, nvarid, tab_cntrl)
66     tab_cntrl(31) = real(itau_dyn+itaufin)
67     ierr = nf_put_var_real(nid, nvarid, tab_cntrl)
68 guez 3
69     ! Ecriture des champs
70    
71 guez 5 ierr = nf_inq_varid(nid, 'ucov', nvarid)
72     IF (ierr/=nf_noerr) THEN
73     PRINT *, 'Variable ucov n est pas definie'
74     STOP 1
75     END IF
76     ierr = nf_put_var_real(nid, nvarid, ucov)
77 guez 3
78 guez 5 ierr = nf_inq_varid(nid, 'vcov', nvarid)
79     IF (ierr/=nf_noerr) THEN
80     PRINT *, 'Variable vcov n est pas definie'
81     STOP 1
82     END IF
83     ierr = nf_put_var_real(nid, nvarid, vcov)
84 guez 3
85 guez 5 ierr = nf_inq_varid(nid, 'teta', nvarid)
86     IF (ierr/=nf_noerr) THEN
87     PRINT *, 'Variable teta n est pas definie'
88     STOP 1
89     END IF
90     ierr = nf_put_var_real(nid, nvarid, teta)
91 guez 3
92 guez 5 DO iq = 1, nqmx
93     ierr = nf_inq_varid(nid, tname(iq), nvarid)
94     IF (ierr/=nf_noerr) THEN
95     PRINT *, 'Variable ', tname(iq), 'n''est pas définie'
96     STOP 1
97     END IF
98     ierr = nf_put_var_real(nid, nvarid, q(1, 1, iq))
99     END DO
100 guez 3
101 guez 5 ierr = nf_inq_varid(nid, 'masse', nvarid)
102     IF (ierr/=nf_noerr) THEN
103     PRINT *, 'Variable masse n est pas definie'
104     STOP 1
105     END IF
106     ierr = nf_put_var_real(nid, nvarid, masse)
107    
108     ierr = nf_inq_varid(nid, 'ps', nvarid)
109     IF (ierr/=nf_noerr) THEN
110     PRINT *, 'Variable ps n est pas definie'
111     STOP 1
112     END IF
113     ierr = nf_put_var_real(nid, nvarid, ps)
114    
115     ierr = nf_close(nid)
116    
117 guez 3 END SUBROUTINE dynredem1

  ViewVC Help
Powered by ViewVC 1.1.21