Changeset 216 for trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90

Timestamp:

2005-03-17T15:02:38+01:00 (20 years ago)

Author:

opalod

Message:

CT : UPDATE151 : New trends organization

File:

• trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90 (modified) (1 diff)

trunk/NEMO/OPA_SRC/DIA/diawri_dimg.h90

@@ -407 +407 @@
 
   END SUBROUTINE dia_wri_state
-
-  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 ctlopn, writn2d
-    !!---------------------------------------------------------------------------
-    !! * subsitutions
-#  include "domzgr_substitute.h90"
-
-    !! * 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 (set to 14)
-         &       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=4) :: clver='@!01'
-    !!---------------------------------------------------------------------------
-
-    !! * Initialisations
-
-    irecl4 = MAX(jpi*jpj*sp , 84+18*sp + (jpk+8)*jpnij*sp  )
-    inum = 14
-
-    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(:)=fsdept(1,1,:)
-
-    CASE ( 'W' )
-       z4dep(:)=fsdepw(1,1,:)
-
-    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
-
-    !! * Open file
-    OPEN (inum, FILE=cd_name, FORM='UNFORMATTED', ACCESS='DIRECT', RECL=irecl4 )
-
-    !! * 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
-
-    !! * Close the file
-    CLOSE(inum)
-
-  END SUBROUTINE dia_wri_dimg