New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
diadimg.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90 @ 2528

Last change on this file since 2528 was 2528, checked in by rblod, 13 years ago

Update NEMOGCM from branch nemo_v3_3_beta

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