/[lmdze]/trunk/libf/dyn3d/dynredem1.f90
ViewVC logotype

Contents of /trunk/libf/dyn3d/dynredem1.f90

Parent Directory Parent Directory | Revision Log Revision Log


Revision 18 - (show annotations)
Thu Aug 7 12:29:13 2008 UTC (15 years, 9 months ago) by guez
File size: 3347 byte(s)
In module "regr_pr", rewrote scanning of horizontal positions as a
single set of loops, using a mask.

Added some "intent" attributes.

In "dynredem0", replaced calls to Fortran 77 interface of NetCDF by
calls to NetCDF95. Removed calls to "nf_redef", regrouped all writing
operations. In "dynredem1", replaced some calls to Fortran 77
interface of NetCDF by calls to Fortran 90 interface.

Renamed variable "nqmax" to "nq_phys".

In "physiq", if "nq >= 5" then "wo" is computed from the
parameterization of "Cariolle".

1 SUBROUTINE dynredem1(fichnom, time, vcov, ucov, teta, q, masse, ps)
2
3 ! From dyn3d/dynredem.F, v 1.2 2004/06/22 11:45:30
4
5 ! Ecriture du fichier de redémarrage au format NetCDF
6
7 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 iniadvtrac_m, ONLY : tname
12 use netcdf, only: nf90_open, nf90_write, nf90_noerr, nf90_inq_varid
13
14 IMPLICIT NONE
15
16 REAL, INTENT (IN) :: vcov(ip1jm, llm), ucov(ip1jmp1, llm), teta(ip1jmp1, llm)
17 REAL, INTENT (IN) :: ps(ip1jmp1), masse(ip1jmp1, llm)
18 REAL, INTENT (IN) :: q(ip1jmp1, llm, nqmx)
19 CHARACTER(len=*), INTENT (IN) :: fichnom
20
21 INCLUDE 'netcdf.inc'
22
23 REAL :: time
24 INTEGER :: nid, nvarid
25 INTEGER :: ierr
26 INTEGER :: iq
27 INTEGER :: length
28 PARAMETER (length=100)
29 REAL :: tab_cntrl(length) ! tableau des parametres du run
30 CHARACTER (len=20) :: modname
31 CHARACTER (len=80) :: abort_message
32 INTEGER :: nb = 0
33
34 !---------------------------------------------------------
35
36 PRINT *, 'Call sequence information: dynredem1'
37
38 modname = 'dynredem1'
39 ierr = nf90_open(fichnom, nf90_write, nid)
40 IF (ierr/=nf90_noerr) THEN
41 PRINT *, 'Pb. d ouverture ' // fichnom
42 STOP 1
43 END IF
44
45 ! Ecriture/extension de la coordonnee temps
46
47 nb = nb + 1
48 ierr = nf90_inq_varid(nid, 'temps', nvarid)
49 IF (ierr/=nf90_noerr) THEN
50 PRINT *, nf_strerror(ierr)
51 abort_message = 'Variable temps n est pas definie'
52 CALL abort_gcm(modname, abort_message, ierr)
53 END IF
54 ierr = nf_put_var1_real(nid, nvarid, nb, time)
55 PRINT *, 'Enregistrement pour ', nb, time
56
57
58 ! Re-ecriture du tableau de controle, itaufin n'est plus defini quand
59 ! on passe dans dynredem0
60 ierr = nf90_inq_varid(nid, 'controle', nvarid)
61 IF (ierr/=nf90_noerr) THEN
62 abort_message = 'dynredem1: Le champ <controle> est absent'
63 ierr = 1
64 CALL abort_gcm(modname, abort_message, ierr)
65 END IF
66 ierr = nf_get_var_real(nid, nvarid, tab_cntrl)
67 tab_cntrl(31) = real(itau_dyn+itaufin)
68 ierr = nf_put_var_real(nid, nvarid, tab_cntrl)
69
70 ! Ecriture des champs
71
72 ierr = nf90_inq_varid(nid, 'ucov', nvarid)
73 IF (ierr/=nf90_noerr) THEN
74 PRINT *, 'Variable ucov n est pas definie'
75 STOP 1
76 END IF
77 ierr = nf_put_var_real(nid, nvarid, ucov)
78
79 ierr = nf90_inq_varid(nid, 'vcov', nvarid)
80 IF (ierr/=nf90_noerr) THEN
81 PRINT *, 'Variable vcov n est pas definie'
82 STOP 1
83 END IF
84 ierr = nf_put_var_real(nid, nvarid, vcov)
85
86 ierr = nf90_inq_varid(nid, 'teta', nvarid)
87 IF (ierr/=nf90_noerr) THEN
88 PRINT *, 'Variable teta n est pas definie'
89 STOP 1
90 END IF
91 ierr = nf_put_var_real(nid, nvarid, teta)
92
93 DO iq = 1, nqmx
94 ierr = nf90_inq_varid(nid, tname(iq), nvarid)
95 IF (ierr/=nf90_noerr) THEN
96 PRINT *, 'Variable ', tname(iq), 'n''est pas définie'
97 STOP 1
98 END IF
99 ierr = nf_put_var_real(nid, nvarid, q(1, 1, iq))
100 END DO
101
102 ierr = nf90_inq_varid(nid, 'masse', nvarid)
103 IF (ierr/=nf90_noerr) THEN
104 PRINT *, 'Variable masse n est pas definie'
105 STOP 1
106 END IF
107 ierr = nf_put_var_real(nid, nvarid, masse)
108
109 ierr = nf90_inq_varid(nid, 'ps', nvarid)
110 IF (ierr/=nf90_noerr) THEN
111 PRINT *, 'Variable ps n est pas definie'
112 STOP 1
113 END IF
114 ierr = nf_put_var_real(nid, nvarid, ps)
115
116 ierr = nf_close(nid)
117
118 END SUBROUTINE dynredem1

  ViewVC Help
Powered by ViewVC 1.1.21