Changeset 5619 for branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

Timestamp:

2015-07-20T19:43:15+02:00 (9 years ago)

Author:

mathiot

Message:

ocean/ice sheet coupling: initial commit

File:

• branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90 (modified) (10 diffs)

branches/NERC/dev_r5589_is_oce_cpl/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

@@ -34 +34 @@
 
    TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read)
+   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsddmp   ! structure of input SST (file informations, fields read)
 
    !! * Substitutions
@@ -60 +61 @@
       TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read
       TYPE(FLD_N)                   ::   sn_tem, sn_sal
+      TYPE(FLD_N)                   ::   sn_dmpt, sn_dmps
       !!
       NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal
+      NAMELIST/namtra_dmpfile/ sn_dmpt, sn_dmps
       INTEGER  ::   ios
       !!----------------------------------------------------------------------
@@ -78 +81 @@
 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtsd in configuration namelist', lwp )
       IF(lwm) WRITE ( numond, namtsd )
+
+      REWIND( numnam_ref )              ! Namelist namtra_dmp in reference namelist : Temperature and salinity damping term
+      READ  ( numnam_ref, namtra_dmpfile, IOSTAT = ios, ERR = 903)
+903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in reference namelist', lwp )
+
+      REWIND( numnam_cfg )              ! Namelist namtra_dmp in configuration namelist : Temperature and salinity damping term
+      READ  ( numnam_cfg, namtra_dmpfile, IOSTAT = ios, ERR = 904 )
+904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtra_dmp in configuration namelist', lwp )
 
       IF( PRESENT( ld_tradmp ) )   ln_tsd_tradmp = .TRUE.     ! forces the initialization when tradmp is used
@@ -105 +116 @@
          !
          ALLOCATE( sf_tsd(jpts), STAT=ierr0 )
+         ALLOCATE( sf_tsddmp(jpts), STAT=ierr0 )
          IF( ierr0 > 0 ) THEN
             CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN
@@ -113 +125 @@
                                 ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
          IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
+         ! dmp file
+                                 ALLOCATE( sf_tsddmp(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 )
+         IF( sn_dmpt%ln_tint )   ALLOCATE( sf_tsddmp(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 )
+                                 ALLOCATE( sf_tsddmp(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 )
+         IF( sn_dmps%ln_tint )   ALLOCATE( sf_tsddmp(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
          !
          IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN
@@ -120 +137 @@
          slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal
          CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
+         slf_i(jp_tem) = sn_dmpt   ;   slf_i(jp_sal) = sn_dmps
+         CALL fld_fill( sf_tsddmp, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd' )
          !
       ENDIF
@@ -128 +147 @@
 
 
-   SUBROUTINE dta_tsd( kt, ptsd )
+   SUBROUTINE dta_tsd( kt, ptsd, ptsddmp )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE dta_tsd  ***
@@ -145 +164 @@
       INTEGER                              , INTENT(in   ) ::   kt     ! ocean time-step
       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), OPTIONAL, INTENT(  out) ::   ptsddmp   ! T & S data
       !
       INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies
@@ -155 +175 @@
       !
       CALL fld_read( kt, 1, sf_tsd )      !==   read T & S data at kt time step   ==!
+      IF ( PRESENT(ptsddmp) ) THEN
+         CALL fld_read( kt, 1, sf_tsddmp )      !==   read T & S data at kt time step   ==!
+         ptsddmp(:,:,:,jp_tem) = sf_tsddmp(jp_tem)%fnow(:,:,:)    ! NO mask
+         ptsddmp(:,:,:,jp_sal) = sf_tsddmp(jp_sal)%fnow(:,:,:) 
+      END IF
       !
       !
@@ -304 +329 @@
          IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta )
                                         DEALLOCATE( sf_tsd              )     ! the structure itself
+         IF(lwp) WRITE(numout,*) 'dta_tsd: deallocte T & S arrays as they are only use to initialize the run'
+                                        DEALLOCATE( sf_tsddmp(jp_tem)%fnow )     ! T arrays in the structure
+         IF( sf_tsddmp(jp_tem)%ln_tint )   DEALLOCATE( sf_tsddmp(jp_tem)%fdta )
+                                        DEALLOCATE( sf_tsddmp(jp_sal)%fnow )     ! S arrays in the structure
+         IF( sf_tsddmp(jp_sal)%ln_tint )   DEALLOCATE( sf_tsddmp(jp_sal)%fdta )
+                                        DEALLOCATE( sf_tsddmp              )     ! the structure itself
       ENDIF
       !