[216] | 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 | USE oce ! ocean dynamics and tracers |
---|
| 9 | USE dom_oce ! ocean space and time domain |
---|
| 10 | USE in_out_manager ! I/O manager |
---|
[1818] | 11 | USE daymod ! calendar |
---|
[3294] | 12 | USE lib_mpp |
---|
[216] | 13 | |
---|
| 14 | IMPLICIT NONE |
---|
| 15 | PRIVATE |
---|
| 16 | |
---|
| 17 | PUBLIC dia_wri_dimg ! called by trd_mld (eg) |
---|
[2715] | 18 | PUBLIC dia_wri_dimg_alloc ! called by nemo_alloc in nemogcm.F90 |
---|
[216] | 19 | |
---|
[2715] | 20 | |
---|
| 21 | !! These workspace arrays are inside the module so that we can make them |
---|
| 22 | !! allocatable in a clean way. Not done in wrk_nemo because these are of KIND(sp). |
---|
| 23 | REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: z42d ! 2d temporary workspace (sp) |
---|
| 24 | REAL(sp), ALLOCATABLE, SAVE, DIMENSION(:) :: z4dep ! vertical level (sp) |
---|
| 25 | |
---|
[216] | 26 | !! * Substitutions |
---|
| 27 | # include "domzgr_substitute.h90" |
---|
| 28 | !!---------------------------------------------------------------------- |
---|
[2528] | 29 | !! NEMO/OPA 3.3 , NEMO Consortium (2010) |
---|
| 30 | !! $Id$ |
---|
| 31 | !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) |
---|
[216] | 32 | !!---------------------------------------------------------------------- |
---|
| 33 | CONTAINS |
---|
| 34 | |
---|
[2715] | 35 | FUNCTION dia_wri_dimg_alloc() |
---|
| 36 | !!--------------------------------------------------------------------- |
---|
| 37 | !! *** ROUTINE dia_wri_dimg_alloc *** |
---|
| 38 | !! |
---|
| 39 | !!--------------------------------------------------------------------- |
---|
| 40 | INTEGER :: dia_wri_dimg_alloc ! return value |
---|
| 41 | !!--------------------------------------------------------------------- |
---|
| 42 | ! |
---|
[3294] | 43 | IF( .NOT. ALLOCATED( z42d ) )THEN |
---|
| 44 | |
---|
| 45 | ALLOCATE( z42d(jpi,jpj), z4dep(jpk), STAT=dia_wri_dimg_alloc ) |
---|
| 46 | |
---|
| 47 | IF( lk_mpp ) CALL mpp_sum ( dia_wri_dimg_alloc ) |
---|
| 48 | IF( dia_wri_dimg_alloc /= 0 ) CALL ctl_warn('dia_wri_dimg_alloc: allocation of array failed.') |
---|
| 49 | |
---|
| 50 | ELSE |
---|
| 51 | |
---|
| 52 | dia_wri_dimg_alloc = 0 |
---|
| 53 | |
---|
| 54 | ENDIF |
---|
[2715] | 55 | ! |
---|
| 56 | END FUNCTION dia_wri_dimg_alloc |
---|
| 57 | |
---|
| 58 | |
---|
| 59 | SUBROUTINE dia_wri_dimg( cd_name, cd_text, ptab, klev, cd_type , ksubi ) |
---|
[216] | 60 | !!------------------------------------------------------------------------- |
---|
| 61 | !! *** ROUTINE dia_wri_dimg *** |
---|
| 62 | !! |
---|
[2715] | 63 | !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text. |
---|
| 64 | !! ptab has klev x 2D fields |
---|
[216] | 65 | !! |
---|
[2715] | 66 | !! ** Action : Define header variables from the config parameters |
---|
| 67 | !! Open the dimg file on unit inum = 14 ( IEEE I4R4 file ) |
---|
| 68 | !! Write header on record 1 |
---|
| 69 | !! Write ptab on the following klev records |
---|
[216] | 70 | !! |
---|
[2715] | 71 | !! History : 2003-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d |
---|
[216] | 72 | !!--------------------------------------------------------------------------- |
---|
| 73 | CHARACTER(len=*),INTENT(in) :: & |
---|
| 74 | & cd_name, & ! dimg file name |
---|
| 75 | & cd_text ! comment to write on record #1 |
---|
| 76 | INTEGER, INTENT(in) :: klev ! number of level in ptab to write |
---|
| 77 | REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab ! 3D array to write |
---|
| 78 | CHARACTER(LEN=1),INTENT(in) :: cd_type ! either 'T', 'W' or '2' , depending on the vertical |
---|
| 79 | ! ! grid for ptab. 2 stands for 2D file |
---|
| 80 | INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi |
---|
| 81 | |
---|
| 82 | !! * Local declarations |
---|
| 83 | INTEGER :: jk, jn ! dummy loop indices |
---|
| 84 | INTEGER :: irecl4, & ! record length in bytes |
---|
[1818] | 85 | & inum, & ! logical unit (set to 14) |
---|
| 86 | & irec, & ! current record to be written |
---|
| 87 | & irecend ! record number where nclit... are stored |
---|
[216] | 88 | REAL(sp) :: zdx,zdy,zspval,zwest,ztimm |
---|
| 89 | REAL(sp) :: zsouth |
---|
| 90 | |
---|
[631] | 91 | CHARACTER(LEN=80) :: clname ! name of file in case of dimgnnn |
---|
| 92 | CHARACTER(LEN=4) :: clver='@!01' ! dimg string identifier |
---|
[216] | 93 | !!--------------------------------------------------------------------------- |
---|
| 94 | |
---|
[2715] | 95 | ! ! allocate dia_wri_dimg array |
---|
| 96 | IF( dia_wri_dimg_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'dia_wri_dimg : unable to allocate arrays' ) |
---|
| 97 | |
---|
[216] | 98 | !! * Initialisations |
---|
| 99 | |
---|
[1818] | 100 | irecl4 = MAX(jpi*jpj*sp , 84+(18+1+jpk)*sp ) |
---|
[216] | 101 | |
---|
| 102 | zspval=0.0_sp ! special values on land |
---|
| 103 | ! the 'numerical' grid is described. The geographical one is in a grid file |
---|
| 104 | zdx=1._sp |
---|
| 105 | zdy=1._sp |
---|
| 106 | zsouth=njmpp * 1._sp |
---|
| 107 | zwest=nimpp * 1._sp |
---|
| 108 | ! time in days since the historical begining of the run (nit000 = 0 ) |
---|
| 109 | ztimm=adatrj |
---|
| 110 | |
---|
| 111 | SELECT CASE ( cd_type ) |
---|
| 112 | |
---|
| 113 | CASE ( 'T') |
---|
[4292] | 114 | z4dep(:)=gdept_1d(:) |
---|
[216] | 115 | |
---|
| 116 | CASE ( 'W' ) |
---|
[4292] | 117 | z4dep(:)=gdepw_1d(:) |
---|
[216] | 118 | |
---|
| 119 | CASE ( '2' ) |
---|
| 120 | z4dep(1:klev) =(/(jk, jk=1,klev)/) |
---|
| 121 | |
---|
| 122 | CASE ( 'I' ) |
---|
| 123 | z4dep(1:klev) = ksubi(1:klev) |
---|
| 124 | |
---|
| 125 | CASE DEFAULT |
---|
[7457] | 126 | WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg' |
---|
| 127 | CALL ctl_stop( 'STOP', 'dia_wri_dimg :bad cd_type in dia_wri_dimg ' ) |
---|
[216] | 128 | END SELECT |
---|
| 129 | |
---|
[631] | 130 | IF ( ln_dimgnnn ) THEN |
---|
[1818] | 131 | irecl4 = MAX(jpi*jpj*sp , 84+(18+jpk)*sp + 8*jpnij*sp ) |
---|
[631] | 132 | WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea |
---|
[1818] | 133 | CALL ctl_opn(inum, clname,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) |
---|
[631] | 134 | WRITE(inum,REC=1 ) clver, cd_text, irecl4, & |
---|
| 135 | & jpi,jpj, klev, 1 , 1 , & |
---|
| 136 | & zwest, zsouth, zdx, zdy, zspval, & |
---|
| 137 | & z4dep(1:klev), & |
---|
| 138 | & ztimm, & |
---|
| 139 | & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, & ! extension to dimg for mpp output |
---|
| 140 | & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! |
---|
[216] | 141 | |
---|
[631] | 142 | !! * Write klev levels |
---|
| 143 | IF ( cd_type == 'I' ) THEN |
---|
[216] | 144 | |
---|
[631] | 145 | DO jk = 1, klev |
---|
| 146 | irec =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 + jk |
---|
| 153 | z42d(:,:) = ptab(:,:,jk) |
---|
| 154 | WRITE(inum,REC=irec) z42d(:,:) |
---|
| 155 | END DO |
---|
| 156 | ENDIF |
---|
| 157 | ELSE |
---|
[1818] | 158 | clver='@!03' ! dimg string identifier |
---|
| 159 | ! note that version @!02 is optimized with respect to record length. |
---|
| 160 | ! The vertical dep variable is reduced to klev instead of klev*jpnij : |
---|
| 161 | ! this is OK for jpnij < 181 (jpk=46) |
---|
| 162 | ! for more processors, irecl4 get huge and that's why we switch to '@!03': |
---|
| 163 | ! In this case we just add an extra integer to the standard dimg structure, |
---|
| 164 | ! which is a record number where the arrays nlci etc... starts (1 per record) |
---|
| 165 | |
---|
[631] | 166 | !! Standard dimgproc (1 file per variable, all procs. write to this file ) |
---|
| 167 | !! * Open file |
---|
[1818] | 168 | CALL ctl_opn(inum, cd_name,'UNKNOWN','UNFORMATTED','DIRECT',irecl4,numout,lwp) |
---|
[216] | 169 | |
---|
[631] | 170 | !! * Write header on record #1 |
---|
[1818] | 171 | irecend=1 + klev*jpnij |
---|
[631] | 172 | IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, & |
---|
[1818] | 173 | & jpi,jpj, klev, 1 , 1 , & |
---|
[631] | 174 | & zwest, zsouth, zdx, zdy, zspval, & |
---|
[1818] | 175 | & z4dep(1:klev), & |
---|
[631] | 176 | & ztimm, & |
---|
[1818] | 177 | & narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom, irecend |
---|
| 178 | IF (lwp ) THEN |
---|
| 179 | WRITE(inum,REC=irecend + 1 ) nlcit |
---|
| 180 | WRITE(inum,REC=irecend + 2 ) nlcjt |
---|
| 181 | WRITE(inum,REC=irecend + 3 ) nldit |
---|
| 182 | WRITE(inum,REC=irecend + 4 ) nldjt |
---|
| 183 | WRITE(inum,REC=irecend + 5 ) nleit |
---|
| 184 | WRITE(inum,REC=irecend + 6 ) nlejt |
---|
| 185 | WRITE(inum,REC=irecend + 7 ) nimppt |
---|
| 186 | WRITE(inum,REC=irecend + 8 ) njmppt |
---|
| 187 | ENDIF |
---|
| 188 | ! & ! extension to dimg for mpp output |
---|
| 189 | ! & nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt ! |
---|
[631] | 190 | |
---|
| 191 | !! * Write klev levels |
---|
| 192 | IF ( cd_type == 'I' ) THEN |
---|
| 193 | |
---|
| 194 | DO jk = 1, klev |
---|
| 195 | irec =1 + klev * (narea -1) + jk |
---|
| 196 | z42d(:,:) = ptab(:,:,ksubi(jk)) |
---|
| 197 | WRITE(inum,REC=irec) z42d(:,:) |
---|
| 198 | END DO |
---|
| 199 | ELSE |
---|
| 200 | DO jk = 1, klev |
---|
| 201 | irec =1 + klev * (narea -1) + jk |
---|
| 202 | z42d(:,:) = ptab(:,:,jk) |
---|
| 203 | WRITE(inum,REC=irec) z42d(:,:) |
---|
| 204 | END DO |
---|
| 205 | ENDIF |
---|
[216] | 206 | ENDIF |
---|
| 207 | |
---|
| 208 | !! * Close the file |
---|
| 209 | CLOSE(inum) |
---|
| 210 | |
---|
| 211 | END SUBROUTINE dia_wri_dimg |
---|
| 212 | |
---|
| 213 | # else |
---|
| 214 | !!---------------------------------------------------------------------- |
---|
| 215 | !! Default option : Empty module |
---|
| 216 | !!---------------------------------------------------------------------- |
---|
| 217 | CONTAINS |
---|
| 218 | |
---|
| 219 | SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type ) |
---|
| 220 | REAL, DIMENSION(:,:,:) :: ptab |
---|
| 221 | INTEGER :: klev |
---|
| 222 | CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type |
---|
| 223 | WRITE(*,*) ' This print must never occur ', cd_name, cd_exper,ptab, klev, cd_type |
---|
| 224 | WRITE(*,*) ' this routine is here just for compilation ' |
---|
| 225 | END SUBROUTINE dia_wri_dimg |
---|
| 226 | # endif |
---|
| 227 | !!====================================================================== |
---|
| 228 | END MODULE diadimg |
---|