source: trunk/NEMO/OPA_SRC/DIA/diadimg.F90 @ 1685

MODULE diadimg
   !!======================================================================
   !!                     ***  MODULE  diadimg  ***
   !! Ocean diagnostics :  write ocean output files in dimg direct access format (mpp)
   !!=====================================================================
# if defined key_dimgout
   !!----------------------------------------------------------------------
   !! * Modules used
   USE oce             ! ocean dynamics and tracers 
   USE dom_oce         ! ocean space and time domain
   USE in_out_manager  ! I/O manager
   USE daymod          ! calendar

   IMPLICIT NONE
   PRIVATE

   !! * Accessibility
   PUBLIC dia_wri_dimg            ! called by trd_mld (eg)

   !! * Substitutions
#  include "domzgr_substitute.h90"
   !!----------------------------------------------------------------------
   !!   OPA 9.0 , LOCEAN-IPSL (2005) 
   !! $Id$ 
   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 
   !!----------------------------------------------------------------------

CONTAINS

  SUBROUTINE dia_wri_dimg(cd_name, cd_text, ptab, klev, cd_type , ksubi )
    !!-------------------------------------------------------------------------
    !!        *** ROUTINE dia_wri_dimg ***
    !!
    !! ** Purpose : write ptab in the dimg file cd_name, with comment cd_text.
    !!       ptab has klev x 2D fields
    !!
    !! ** Action :
    !!       Define header variables from the config parameters
    !!       Open the dimg file on unit inum = 14 ( IEEE I4R4 file )
    !!       Write header on record 1
    !!       Write ptab on the following klev records
    !!
    !! History :
    !!   03-12 (J.M. Molines ) : Original. Replace ctl_opn, writn2d
    !!---------------------------------------------------------------------------
    !! * Arguments
    CHARACTER(len=*),INTENT(in) ::   &
         &                            cd_name,  &  ! dimg file name
         &                            cd_text      ! comment to write on record #1
    INTEGER, INTENT(in) ::            klev         ! number of level in ptab to write
    REAL(wp),INTENT(in), DIMENSION(:,:,:) :: ptab  ! 3D array to write 
    CHARACTER(LEN=1),INTENT(in) ::    cd_type      ! either 'T', 'W' or '2' , depending on the vertical
    !                                              ! grid for ptab. 2 stands for 2D file
    INTEGER, INTENT(in), OPTIONAL, DIMENSION(klev) :: ksubi 

    !! * Local declarations
    INTEGER :: jk, jn           ! dummy loop indices
    INTEGER :: irecl4,             &    ! record length in bytes
         &       inum,             &    ! logical unit
         &       irec                   ! current record to be written
    REAL(sp)                    :: zdx,zdy,zspval,zwest,ztimm
    REAL(sp)                    :: zsouth
    REAL(sp),DIMENSION(jpi,jpj) :: z42d        ! 2d temporary workspace (sp)
    REAL(sp),DIMENSION(jpk)     :: z4dep       ! vertical level (sp)

    CHARACTER(LEN=80) :: clname                ! name of file in case of dimgnnn
    CHARACTER(LEN=4) :: clver='@!01'           ! dimg string identifier
    !!---------------------------------------------------------------------------

    !! * Initialisations

    irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp  )

    zspval=0.0_sp    ! special values on land
    !  the 'numerical' grid is described. The geographical one is in a grid file
    zdx=1._sp
    zdy=1._sp
    zsouth=njmpp * 1._sp
    zwest=nimpp * 1._sp
    !  time in days since the historical begining of the run (nit000 = 0 ) 
    ztimm=adatrj

    SELECT CASE ( cd_type )

    CASE ( 'T')
       z4dep(:)=gdept_0(:)

    CASE ( 'W' )
       z4dep(:)=gdepw_0(:)

    CASE ( '2' )
       z4dep(1:klev) =(/(jk, jk=1,klev)/)

    CASE ( 'I' )
       z4dep(1:klev) = ksubi(1:klev)

    CASE DEFAULT
       IF(lwp) WRITE(numout,*) ' E R R O R : bad cd_type in dia_wri_dimg '
       STOP 'dia_wri_dimg'

    END SELECT

    IF ( ln_dimgnnn  ) THEN
       WRITE(clname,'(a,a,i3.3)') TRIM(cd_name),'.',narea
       CALL ctl_opn( inum, clname, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp )
       WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
            &     jpi,jpj, klev, 1 , 1 ,            &
            &     zwest, zsouth, zdx, zdy, zspval,  &
            &     z4dep(1:klev),                    &
            &     ztimm,                            &
            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output
            &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !

       !! * Write klev levels
       IF ( cd_type == 'I' ) THEN

          DO jk = 1, klev
             irec =1 + jk
             z42d(:,:) = ptab(:,:,ksubi(jk))
             WRITE(inum,REC=irec)  z42d(:,:)
          END DO
       ELSE
          DO jk = 1, klev
             irec =1 + jk
             z42d(:,:) = ptab(:,:,jk)
             WRITE(inum,REC=irec)  z42d(:,:)
          END DO
       ENDIF
    ELSE
       !! Standard dimgproc (1 file per variable, all procs. write to this file )
       !! * Open file
       CALL ctl_opn( inum, cd_name, 'REPLACE', 'UNFORMATTED', 'DIRECT', irecl4, numout, lwp )

       !! * Write header on record #1
       IF(lwp) WRITE(inum,REC=1 ) clver, cd_text, irecl4, &
            &     jpi,jpj, klev*jpnij, 1 , 1 ,            &
            &     zwest, zsouth, zdx, zdy, zspval,  &
            &     (z4dep(1:klev),jn=1,jpnij),       &
            &     ztimm,                            &
            &     narea, jpnij,jpiglo,jpjglo,jpizoom, jpjzoom,    &    ! extension to dimg for mpp output
            &     nlcit,nlcjt, nldit, nldjt, nleit, nlejt, nimppt, njmppt  !

       !! * Write klev levels
       IF ( cd_type == 'I' ) THEN

          DO jk = 1, klev
             irec =1 + klev * (narea -1) + jk
             z42d(:,:) = ptab(:,:,ksubi(jk))
             WRITE(inum,REC=irec)  z42d(:,:)
          END DO
       ELSE
          DO jk = 1, klev
             irec =1 + klev * (narea -1) + jk
             z42d(:,:) = ptab(:,:,jk)
             WRITE(inum,REC=irec)  z42d(:,:)
          END DO
       ENDIF
    ENDIF

    !! * Close the file
    CLOSE(inum)

  END SUBROUTINE dia_wri_dimg

#  else
   !!----------------------------------------------------------------------
   !!   Default option :                                       Empty module
   !!----------------------------------------------------------------------
CONTAINS

   SUBROUTINE dia_wri_dimg( cd_name, cd_exper, ptab, klev, cd_type )
      REAL, DIMENSION(:,:,:) :: ptab
      INTEGER :: klev
      CHARACTER(LEN=80) :: cd_name, cd_exper,cd_type
      WRITE(*,*) ' This print must never occur ', cd_name, cd_exper,ptab, klev, cd_type
      WRITE(*,*) ' this routine is here just for compilation '
   END SUBROUTINE dia_wri_dimg
# endif
   !!======================================================================
END MODULE diadimg