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 tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/DIA – NEMO

source: tags/nemo_v3_2/nemo_v3_2/NEMO/OPA_SRC/DIA/diadimg.F90 @ 1878

Last change on this file since 1878 was 1878, checked in by flavoni, 14 years ago

initial test for nemogcm
File size: 6.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
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: diadimg.F90 1715 2009-11-05 15:18:26Z smasson $
24   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
25   !!----------------------------------------------------------------------
26
27CONTAINS
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   !!----------------------------------------------------------------------
168CONTAINS
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   !!======================================================================
179END MODULE diadimg
Note: See TracBrowser for help on using the repository browser.