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

Annotation of /trunk/dyn3d/wrgrads.f

Parent Directory Parent Directory | Revision Log Revision Log

Revision 102 - (hide annotations)
Tue Jul 15 13:43:24 2014 UTC (9 years, 11 months ago) by guez
File size: 3717 byte(s) 
Removed unused file "condsurf.f" (only useful for ocean slab).

day_step must be a multiple of 4 * iperiod if ok_guide.

Changed type of variable online of module conf_guide_m from integer to
logical. Value -1 was not useful, equivalent to not ok_guide.

Removed argument masse of procedure guide. masse is kept consistent
with ps throughout the run. masse need only be computed again just
after ps has been modified. In prodecure guide, replaced use of
remanent variable first by test on itau. Replaced test on variable
"test" by test on integer values.

In leapfrog, for the call to guide, replaced test on real values by
test on integer values.

Bug fix in tau2alpha: computation of dxdyv (following LMDZ revision 1040).

In procedure wrgrads, replaced badly chosen argument name "if" by i_f.
1 guez 3
2 guez 81 ! $Header: /home/cvsroot/LMDZ4/libf/dyn3d/wrgrads.F,v 1.2 2004/06/22 11:45:30
3     ! lmdzadmin Exp $
4 guez 3
5 guez 102 SUBROUTINE wrgrads(i_f, nl, field, name, titlevar)
6 guez 81 USE gradsdef
7     IMPLICIT NONE
8 guez 3
9 guez 81 ! Declarations
10 guez 102 ! i_f indice du fichier
11 guez 81 ! nl nombre de couches
12     ! field champ
13     ! name petit nom
14     ! titlevar Titre
15 guez 3
16    
17 guez 81 ! arguments
18 guez 102 INTEGER, INTENT(IN):: i_f
19     integer nl
20     REAL, INTENT(IN):: field(imx*jmx*lmx)
21 guez 81 CHARACTER *10 name, file
22     CHARACTER *10 titlevar
23 guez 3
24 guez 81 ! local
25 guez 3
26 guez 81 INTEGER im, jm, lm, i, j, l, lnblnk, iv, iii, iji, iif, ijf
27 guez 3
28 guez 81 LOGICAL writectl
29 guez 3
30    
31 guez 81 writectl = .FALSE.
32 guez 3
33 guez 102 PRINT *, i_f, iid(i_f), jid(i_f), ifd(i_f), jfd(i_f)
34     iii = iid(i_f)
35     iji = jid(i_f)
36     iif = ifd(i_f)
37     ijf = jfd(i_f)
38 guez 81 im = iif - iii + 1
39     jm = ijf - iji + 1
40 guez 102 lm = lmd(i_f)
41 guez 3
42 guez 102 PRINT *, 'im,jm,lm,name,firsttime(i_f)'
43     PRINT *, im, jm, lm, name, firsttime(i_f)
44 guez 3
45 guez 102 IF (firsttime(i_f)) THEN
46     IF (name==var(1,i_f)) THEN
47     firsttime(i_f) = .FALSE.
48     ivar(i_f) = 1
49 guez 81 PRINT *, 'fin de l initialiation de l ecriture du fichier'
50     PRINT *, file
51 guez 102 PRINT *, 'fichier no: ', i_f
52     PRINT *, 'unit ', unit(i_f)
53     PRINT *, 'nvar ', nvar(i_f)
54     PRINT *, 'vars ', (var(iv,i_f), iv=1, nvar(i_f))
55 guez 81 ELSE
56 guez 102 ivar(i_f) = ivar(i_f) + 1
57     nvar(i_f) = ivar(i_f)
58     var(ivar(i_f), i_f) = name
59     tvar(ivar(i_f), i_f) = titlevar(1:lnblnk(titlevar))
60     nld(ivar(i_f), i_f) = nl
61     PRINT *, 'initialisation ecriture de ', var(ivar(i_f), i_f)
62     PRINT *, 'i_f ivar(i_f) nld ', i_f, ivar(i_f), nld(ivar(i_f), i_f)
63 guez 81 END IF
64     writectl = .TRUE.
65 guez 102 itime(i_f) = 1
66 guez 81 ELSE
67 guez 102 ivar(i_f) = mod(ivar(i_f), nvar(i_f)) + 1
68     IF (ivar(i_f)==nvar(i_f)) THEN
69 guez 81 writectl = .TRUE.
70 guez 102 itime(i_f) = itime(i_f) + 1
71 guez 81 END IF
72 guez 3
73 guez 102 IF (var(ivar(i_f),i_f)/=name) THEN
74 guez 81 PRINT *, 'Il faut stoker la meme succession de champs a chaque'
75     PRINT *, 'pas de temps'
76 guez 102 PRINT *, 'fichier no: ', i_f
77     PRINT *, 'unit ', unit(i_f)
78     PRINT *, 'nvar ', nvar(i_f)
79     PRINT *, 'vars ', (var(iv,i_f), iv=1, nvar(i_f))
80 guez 3
81 guez 81 STOP
82     END IF
83     END IF
84 guez 3
85 guez 102 PRINT *, 'ivar(i_f),nvar(i_f),var(ivar(i_f),i_f),writectl'
86     PRINT *, ivar(i_f), nvar(i_f), var(ivar(i_f), i_f), writectl
87 guez 81 DO l = 1, nl
88 guez 102 irec(i_f) = irec(i_f) + 1
89     ! print*,'Ecrit rec=',irec(i_f),iii,iif,iji,ijf,
90     ! s (l-1)*imd(i_f)*jmd(i_f)+(iji-1)*imd(i_f)+iii
91     ! s ,(l-1)*imd(i_f)*jmd(i_f)+(ijf-1)*imd(i_f)+iif
92     WRITE (unit(i_f)+1, REC=irec(i_f))((field((l-1)*imd(i_f)*jmd(i_f)+ &
93     (j-1)*imd(i_f)+i),i=iii,iif), j=iji, ijf)
94 guez 81 END DO
95     IF (writectl) THEN
96 guez 3
97 guez 102 file = fichier(i_f)
98 guez 81 ! WARNING! on reecrase le fichier .ctl a chaque ecriture
99 guez 102 OPEN (unit(i_f), FILE=file(1:lnblnk(file))//'.ctl', FORM='formatted', &
100 guez 81 STATUS='unknown')
101 guez 102 WRITE (unit(i_f), '(a5,1x,a40)') 'DSET ', '^' // file(1:lnblnk(file)) // &
102 guez 81 '.dat'
103 guez 3
104 guez 102 WRITE (unit(i_f), '(a12)') 'UNDEF 1.0E30'
105     WRITE (unit(i_f), '(a5,1x,a40)') 'TITLE ', title(i_f)
106     CALL formcoord(unit(i_f), im, xd(iii,i_f), 1., .FALSE., 'XDEF')
107     CALL formcoord(unit(i_f), jm, yd(iji,i_f), 1., .TRUE., 'YDEF')
108     CALL formcoord(unit(i_f), lm, zd(1,i_f), 1., .FALSE., 'ZDEF')
109     WRITE (unit(i_f), '(a4,i10,a30)') 'TDEF ', itime(i_f), &
110 guez 81 ' LINEAR 02JAN1987 1MO '
111 guez 102 WRITE (unit(i_f), '(a4,2x,i5)') 'VARS', nvar(i_f)
112     DO iv = 1, nvar(i_f)
113     ! print*,'i_f,var(iv,i_f),nld(iv,i_f),nld(iv,i_f)-1/nld(iv,i_f)'
114     ! print*,i_f,var(iv,i_f),nld(iv,i_f),nld(iv,i_f)-1/nld(iv,i_f)
115     WRITE (unit(i_f), 1000) var(iv, i_f), nld(iv, i_f) - 1/nld(iv, i_f), 99, &
116     tvar(iv, i_f)
117 guez 81 END DO
118 guez 102 WRITE (unit(i_f), '(a7)') 'ENDVARS'
119 guez 3
120 guez 81 1000 FORMAT (A5, 3X, I4, I3, 1X, A39)
121 guez 3
122 guez 102 CLOSE (unit(i_f))
123 guez 3
124 guez 81 END IF ! writectl
125    
126     RETURN
127    
128     END SUBROUTINE wrgrads
129    
  ViewVC Help
Powered by ViewVC 1.1.21