1 | MODULE diadimg |
---|
2 | !!====================================================================== |
---|
3 | !! *** MODULE diadimg *** |
---|
4 | !! Ocean diagnostics : write ocean output files in dimg direct access format (mpp) |
---|
5 | !!===================================================================== |
---|
6 | # if defined key_dimgout |
---|
7 | !!---------------------------------------------------------------------- |
---|
8 | !! * Modules used |
---|
9 | USE oce ! ocean dynamics and tracers |
---|
10 | USE dom_oce ! ocean space and time domain |
---|
11 | USE in_out_manager ! I/O manager |
---|
12 | |
---|
13 | IMPLICIT NONE |
---|
14 | PRIVATE |
---|
15 | |
---|
16 | !! * Accessibility |
---|
17 | PUBLIC dia_wri_dimg ! called by trd_mld (eg) |
---|
18 | |
---|
19 | !! * Substitutions |
---|
20 | # include "domzgr_substitute.h90" |
---|
21 | !!---------------------------------------------------------------------- |
---|
22 | !! OPA 9.0 , LOCEAN-IPSL (2005) |
---|
23 | !! $Id$ |
---|
24 | !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt |
---|
25 | !!---------------------------------------------------------------------- |
---|
26 | |
---|
27 | CONTAINS |
---|
28 | |
---|
29 | SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi ) |
---|
30 | !!------------------------------------------------------------------------- |
---|
31 | !! *** ROUTINE dia_wri_dimg *** |
---|
32 | !! |
---|
33 | !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. |
---|
34 | !! ptab has klev x 2D fields |
---|
35 | !! |
---|
36 | !! ** Action : |
---|
37 | !! Define header variables from the config parameters |
---|
38 | !! Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) |
---|
39 | !! Write header on record 1 |
---|
40 | !! Write ptab on the following klev records |
---|
41 | !! |
---|
42 | !! History : |
---|
43 | !! 03-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d |
---|
44 | !!--------------------------------------------------------------------------- |
---|
45 | !! * Arguments |
---|
46 | CHARACTER(len=*),INTENT(in) :: & |
---|
47 | & cd_name, & ! dimg file name |
---|
48 | & cd_text ! comment to write on record #1 |
---|
49 | INTEGER, INTENT(in) :: klev ! number of level in ptab to write |
---|
50 | REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab ! 3D array to write |
---|
51 | CHARACTER(LEN=1),INTENT(in) :: cd_type ! either 'T', 'W' or '2' , depending on the vertical |
---|
52 | ! ! grid for ptab. 2 stands for 2D file |
---|
53 | INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi |
---|
54 | |
---|
55 | !! * Local declarations |
---|
56 | INTEGER :: jk, jn ! dummy loop indices |
---|
57 | INTEGER :: irecl4, & ! record length in bytes |
---|
58 | & inum, & ! logical unit |
---|
59 | & irec ! current record to be written |
---|
60 | REAL(sp) :: zdx,zdy,zspval,zwest,ztimm |
---|
61 | REAL(sp) :: zsouth |
---|
62 | REAL(sp),DIMENSION(jpi,jpj) :: z42d ! 2d temporary workspace (sp) |
---|
63 | REAL(sp),DIMENSION(jpk) :: z4dep ! vertical level (sp) |
---|
64 | |
---|
65 | CHARACTER(LEN=80) :: clname ! name of file in case of dimgnnn |
---|
66 | CHARACTER(LEN=4) :: clver='@!01' ! dimg string identifier |
---|
67 | !!--------------------------------------------------------------------------- |
---|
68 | |
---|
69 | !! * Initialisations |
---|
70 | |
---|
71 | irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp ) |
---|
72 | |
---|
73 | zspval=0.0_sp ! special values on land |
---|
74 | ! the 'numerical' grid is described. The geographical one is in a grid file |
---|
75 | zdx=1._sp |
---|
76 | zdy=1._sp |
---|
77 | zsouth=njmpp * 1._sp |
---|
78 | zwest=nimpp * 1._sp |
---|
79 | ! time in days since the historical begining of the run (nit000 = 0 ) |
---|
80 | ztimm=adatrj |
---|
81 | |
---|
82 | SELECT CASE ( cd_type ) |
---|
83 | |
---|
84 | CASE ( 'T') |
---|
85 | z4dep(:)=gdept_0(:) |
---|
86 | |
---|
87 | CASE ( 'W' ) |
---|
88 | z4dep(:)=gdepw_0(:) |
---|
89 | |
---|
90 | CASE ( '2' ) |
---|
91 | z4dep(1:klev) =(/(jk, jk=1,klev)/) |
---|
92 | |
---|
93 | CASE ( 'I' ) |
---|
94 | z4dep(1:klev) = ksubi(1:klev) |
---|
95 | |
---|
96 | CASE DEFAULT |
---|
97 | IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg ' |
---|
98 | STOP 'dia_wri_dimg' |
---|
99 | |
---|
100 | END SELECT |
---|
101 | |
---|
102 | IF ( ln_dimgnnn ) THEN |
---|
103 | WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea |
---|
104 | CALL ctl_opn( inum, clname, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) |
---|
105 | WRITE(inum,REC=1 ) clver, cd_text, irecl4, & |
---|
106 | & jpi,jpj, klev, 1 , 1 , & |
---|
107 | & zwest, zsouth, zdx, zdy, zspval, & |
---|
108 | & z4dep(1:klev), & |
---|
109 | & ztimm, & |
---|
110 | & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, & ! extension to dimg for mpp output |
---|
111 | & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! |
---|
112 | |
---|
113 | !! * Write klev levels |
---|
114 | IF ( cd_type == 'I' ) THEN |
---|
115 | |
---|
116 | DO jk = 1, klev |
---|
117 | irec =1 + jk |
---|
118 | z42d(:,:) = ptab(:,:,ksubi(jk)) |
---|
119 | WRITE(inum,REC=irec) z42d(:,:) |
---|
120 | END DO |
---|
121 | ELSE |
---|
122 | DO jk = 1, klev |
---|
123 | irec =1 + jk |
---|
124 | z42d(:,:) = ptab(:,:,jk) |
---|
125 | WRITE(inum,REC=irec) z42d(:,:) |
---|
126 | END DO |
---|
127 | ENDIF |
---|
128 | ELSE |
---|
129 | !! Standard dimgproc (1 file per variable, all procs. write to this file ) |
---|
130 | !! * Open file |
---|
131 | CALL ctl_opn( inum, cd_name, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp ) |
---|
132 | |
---|
133 | !! * Write header on record #1 |
---|
134 | IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & |
---|
135 | & jpi,jpj, klev*jpnij, 1 , 1 , & |
---|
136 | & zwest, zsouth, zdx, zdy, zspval, & |
---|
137 | & (z4dep(1:klev),jn=1,jpnij), & |
---|
138 | & ztimm, & |
---|
139 | & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, & ! extension to dimg for mpp output |
---|
140 | & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! |
---|
141 | |
---|
142 | !! * Write klev levels |
---|
143 | IF ( cd_type == 'I' ) THEN |
---|
144 | |
---|
145 | DO jk = 1, klev |
---|
146 | irec =1 + klev * (narea -1) + jk |
---|
147 | z42d(:,:) = ptab(:,:,ksubi(jk)) |
---|
148 | WRITE(inum,REC=irec) z42d(:,:) |
---|
149 | END DO |
---|
150 | ELSE |
---|
151 | DO jk = 1, klev |
---|
152 | irec =1 + klev * (narea -1) + jk |
---|
153 | z42d(:,:) = ptab(:,:,jk) |
---|
154 | WRITE(inum,REC=irec) z42d(:,:) |
---|
155 | END DO |
---|
156 | ENDIF |
---|
157 | ENDIF |
---|
158 | |
---|
159 | !! * Close the file |
---|
160 | CLOSE(inum) |
---|
161 | |
---|
162 | END SUBROUTINE dia_wri_dimg |
---|
163 | |
---|
164 | # else |
---|
165 | !!---------------------------------------------------------------------- |
---|
166 | !! Default option : Empty module |
---|
167 | !!---------------------------------------------------------------------- |
---|
168 | CONTAINS |
---|
169 | |
---|
170 | SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type ) |
---|
171 | REAL, DIMENSION(:,:,:) :: ptab |
---|
172 | INTEGER :: klev |
---|
173 | CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type |
---|
174 | WRITE(*,*) ' This print must never occur ', cd_name, cd_exper,ptab, klev, cd_type |
---|
175 | WRITE(*,*) ' this routine is here just for compilation ' |
---|
176 | END SUBROUTINE dia_wri_dimg |
---|
177 | # endif |
---|
178 | !!====================================================================== |
---|
179 | END MODULE diadimg |
---|