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 branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/OPA_SRC/DIA/diadimg.F90 @ 5845

Last change on this file since 5845 was 5845, checked in by gm, 9 years ago

#1613: vvl by default: suppression of domzgr_substitute.h90

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