Changeset 10724


Ignore:
Timestamp:
2019-02-27T12:39:03+01:00 (17 months ago)
Author:
jcastill
Message:

Leave the two files modified as in the trunk, following NOC changes

Location:
branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/DOM/dtatsd.F90

    r10685 r10724  
    2323   USE wrk_nemo        ! Memory allocation 
    2424   USE timing          ! Timing 
    25    USE iom 
    2625 
    2726   IMPLICIT NONE 
     
    3231 
    3332   LOGICAL , PUBLIC ::   ln_tsd_init      !: T & S data flag 
    34    LOGICAL , PUBLIC ::   ln_tsd_interp    !: vertical interpolation flag 
    3533   LOGICAL , PUBLIC ::   ln_tsd_tradmp    !: internal damping toward input data flag 
    3634 
    3735   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_tsd   ! structure of input SST (file informations, fields read) 
    38    INTEGER                                 ::   jpk_init , inum_dta 
    39    INTEGER                                 ::   id ,linum   ! local integers 
    40    INTEGER                                 ::   zdim(4) 
    4136 
    4237   !!---------------------------------------------------------------------- 
     
    5853      LOGICAL, INTENT(in), OPTIONAL ::   ld_tradmp   ! force the initialization when tradp is used 
    5954      ! 
    60       INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3, ierr4, ierr5   ! local integers 
     55      INTEGER ::   ios, ierr0, ierr1, ierr2, ierr3   ! local integers 
    6156      !! 
    6257      CHARACTER(len=100)            ::   cn_dir          ! Root directory for location of ssr files 
    63       TYPE(FLD_N), DIMENSION(jpts+2)::   slf_i           ! array of namelist informations on the fields to read 
    64       TYPE(FLD_N)                   ::   sn_tem, sn_sal, sn_dep, sn_msk 
    65        
     58      TYPE(FLD_N), DIMENSION( jpts) ::   slf_i           ! array of namelist informations on the fields to read 
     59      TYPE(FLD_N)                   ::   sn_tem, sn_sal 
    6660      !! 
    67       NAMELIST/namtsd/   ln_tsd_init, ln_tsd_interp, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal, sn_dep, sn_msk 
     61      NAMELIST/namtsd/   ln_tsd_init, ln_tsd_tradmp, cn_dir, sn_tem, sn_sal 
    6862      !!---------------------------------------------------------------------- 
    6963      ! 
     
    7165      ! 
    7266      !  Initialisation 
    73       ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0  ; ierr4 = 0  ;  ierr5 = 0  
     67      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0 
    7468      ! 
    7569      REWIND( numnam_ref )              ! Namelist namtsd in reference namelist :  
     
    9084         WRITE(numout,*) '   Namelist namtsd' 
    9185         WRITE(numout,*) '      Initialisation of ocean T & S with T &S input data   ln_tsd_init   = ', ln_tsd_init 
    92          WRITE(numout,*) '      iInterpolation of initial conditions in the vertical ln_tsd_interp = ', ln_tsd_interp 
    9386         WRITE(numout,*) '      damping of ocean T & S toward T &S input data        ln_tsd_tradmp = ', ln_tsd_tradmp 
    9487         WRITE(numout,*) 
     
    10497         ln_tsd_init = .FALSE. 
    10598      ENDIF 
    106       IF( ln_tsd_interp .AND. ln_tsd_tradmp ) THEN 
    107             CALL ctl_stop( 'dta_tsd_init: Tracer damping and vertical interpolation not yet configured' )   ;   RETURN 
    108       ENDIF 
    109       IF( ln_tsd_interp .AND. LEN(TRIM(sn_msk%wname)) > 0 ) THEN 
    110             CALL ctl_stop( 'dta_tsd_init: Using vertical interpolation and weights files not recommended' )   ;   RETURN 
    111       ENDIF 
    11299      ! 
    113100      !                             ! allocate the arrays (if necessary) 
    114101      IF(  ln_tsd_init .OR. ln_tsd_tradmp  ) THEN 
    115102         ! 
    116          IF( ln_tsd_interp ) THEN 
    117            ALLOCATE( sf_tsd(jpts+2), STAT=ierr0 ) ! to carry the addtional depth information 
    118          ELSE 
    119            ALLOCATE( sf_tsd(jpts  ), STAT=ierr0 )  
    120          ENDIF  
     103         ALLOCATE( sf_tsd(jpts), STAT=ierr0 ) 
    121104         IF( ierr0 > 0 ) THEN 
    122105            CALL ctl_stop( 'dta_tsd_init: unable to allocate sf_tsd structure' )   ;   RETURN 
    123106         ENDIF 
    124107         ! 
    125          IF( ln_tsd_interp ) THEN 
    126             CALL iom_open ( trim(cn_dir) // trim(sn_dep%clname), inum_dta )  
    127             id = iom_varid( inum_dta, sn_dep%clvar, zdim ) 
    128             jpk_init = zdim(3) 
    129             IF(lwp) WRITE(numout,*) 'Dimension of veritcal coordinate in ICs: ', jpk_init 
    130             CALL iom_close( inum_dta )   ! Close the input file 
    131             ! 
    132                                  ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr0 ) 
    133             IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr1 ) 
    134                                  ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr2 ) 
    135             IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk_init,2) , STAT=ierr3 )   
    136                                  ALLOCATE( sf_tsd(jp_dep)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr4 ) 
    137                                  ALLOCATE( sf_tsd(jp_msk)%fnow(jpi,jpj,jpk_init  ) , STAT=ierr5 ) 
    138          ELSE 
    139                                  ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 ) 
    140             IF( sn_tem%ln_tint ) ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 
    141                                  ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
    142             IF( sn_sal%ln_tint ) ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )   
    143          ENDIF ! ln_tsd_interp 
    144  
    145          ! 
    146          IF( ierr0 + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 > 0 ) THEN 
     108                                ALLOCATE( sf_tsd(jp_tem)%fnow(jpi,jpj,jpk)   , STAT=ierr0 ) 
     109         IF( sn_tem%ln_tint )   ALLOCATE( sf_tsd(jp_tem)%fdta(jpi,jpj,jpk,2) , STAT=ierr1 ) 
     110                                ALLOCATE( sf_tsd(jp_sal)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
     111         IF( sn_sal%ln_tint )   ALLOCATE( sf_tsd(jp_sal)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
     112         ! 
     113         IF( ierr0 + ierr1 + ierr2 + ierr3 > 0 ) THEN 
    147114            CALL ctl_stop( 'dta_tsd : unable to allocate T & S data arrays' )   ;   RETURN 
    148115         ENDIF 
    149116         !                         ! fill sf_tsd with sn_tem & sn_sal and control print 
    150117         slf_i(jp_tem) = sn_tem   ;   slf_i(jp_sal) = sn_sal 
    151          IF( ln_tsd_interp ) slf_i(jp_dep) = sn_dep   ;   slf_i(jp_msk) = sn_msk 
    152118         CALL fld_fill( sf_tsd, slf_i, cn_dir, 'dta_tsd', 'Temperature & Salinity data', 'namtsd', no_print ) 
    153119         ! 
     
    177143      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(  out) ::   ptsd   ! T & S data 
    178144      ! 
    179       INTEGER ::   ji, jj, jk, jl, jk_init   ! dummy loop indicies 
    180       INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1        ! local integers 
     145      INTEGER ::   ji, jj, jk, jl, jkk   ! dummy loop indicies 
     146      INTEGER ::   ik, il0, il1, ii0, ii1, ij0, ij1   ! local integers 
    181147      REAL(wp)::   zl, zi 
     148      REAL(wp), POINTER, DIMENSION(:) ::  ztp, zsp   ! 1D workspace 
    182149      !!---------------------------------------------------------------------- 
    183150      ! 
     
    214181!!gm end 
    215182      ! 
    216       IF( kt == nit000 .AND. lwp )THEN 
    217          WRITE(numout,*) 
    218          WRITE(numout,*) 'dta_tsd: interpolates T & S data onto current mesh' 
    219       ENDIF 
    220       ! 
    221       IF( ln_tsd_interp ) THEN                 ! probably should use pointers in the following to make more readable 
    222       ! 
    223          DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    224             DO jj= 1, jpj 
    225                DO ji= 1, jpi 
     183      ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)    ! NO mask 
     184      ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:)  
     185      ! 
     186      IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     187         ! 
     188         CALL wrk_alloc( jpk, ztp, zsp ) 
     189         ! 
     190         IF( kt == nit000 .AND. lwp )THEN 
     191            WRITE(numout,*) 
     192            WRITE(numout,*) 'dta_tsd: interpolates T & S data onto the s- or mixed s-z-coordinate mesh' 
     193         ENDIF 
     194         ! 
     195         DO jj = 1, jpj                         ! vertical interpolation of T & S 
     196            DO ji = 1, jpi 
     197               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    226198                  zl = gdept_0(ji,jj,jk) 
    227                   IF( zl < sf_tsd(jp_dep)%fnow(ji,jj,1) ) THEN                     ! above the first level of data 
    228                      ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,1)  
    229                      ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,1) 
    230                   ELSEIF( zl > sf_tsd(jp_dep)%fnow(ji,jj,jpk_init) ) THEN          ! below the last level of data 
    231                      ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jpk_init) 
    232                      ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jpk_init) 
    233                   ELSE                                                             ! inbetween : vertical interpolation between jk_init & jk_init+1 
    234                      DO jk_init = 1, jpk_init-1                                    ! when  gdept(jk_init) < zl < gdept(jk_init+1) 
    235                         IF( sf_tsd(jp_msk)%fnow(ji,jj,jk_init+1) == 0 ) THEN       ! if there is no data fill down 
    236                            sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) 
    237                            sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) 
    238                         ENDIF 
    239                         IF( (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) * (zl-sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)) <= 0._wp ) THEN 
    240                            zi = ( zl - sf_tsd(jp_dep)%fnow(ji,jj,jk_init) ) / & 
    241                         &       (sf_tsd(jp_dep)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_dep)%fnow(ji,jj,jk_init)) 
    242                            ptsd(ji,jj,jk,jp_tem) = sf_tsd(jp_tem)%fnow(ji,jj,jk_init) + & 
    243                         &                          (sf_tsd(jp_tem)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_tem)%fnow(ji,jj,jk_init)) * zi 
    244                            ptsd(ji,jj,jk,jp_sal) = sf_tsd(jp_sal)%fnow(ji,jj,jk_init) + & 
    245                         &                          (sf_tsd(jp_sal)%fnow(ji,jj,jk_init+1)-sf_tsd(jp_sal)%fnow(ji,jj,jk_init)) * zi 
     199                  IF(     zl < gdept_1d(1  ) ) THEN          ! above the first level of data 
     200                     ztp(jk) =  ptsd(ji,jj,1    ,jp_tem) 
     201                     zsp(jk) =  ptsd(ji,jj,1    ,jp_sal) 
     202                  ELSEIF( zl > gdept_1d(jpk) ) THEN          ! below the last level of data 
     203                     ztp(jk) =  ptsd(ji,jj,jpkm1,jp_tem) 
     204                     zsp(jk) =  ptsd(ji,jj,jpkm1,jp_sal) 
     205                  ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     206                     DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     207                        IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
     208                           zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
     209                           ztp(jk) = ptsd(ji,jj,jkk,jp_tem) + ( ptsd(ji,jj,jkk+1,jp_tem) - ptsd(ji,jj,jkk,jp_tem) ) * zi  
     210                           zsp(jk) = ptsd(ji,jj,jkk,jp_sal) + ( ptsd(ji,jj,jkk+1,jp_sal) - ptsd(ji,jj,jkk,jp_sal) ) * zi 
    246211                        ENDIF 
    247212                     END DO 
    248213                  ENDIF 
    249                ENDDO 
    250             ENDDO 
     214               END DO 
     215               DO jk = 1, jpkm1 
     216                  ptsd(ji,jj,jk,jp_tem) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     217                  ptsd(ji,jj,jk,jp_sal) = zsp(jk) * tmask(ji,jj,jk) 
     218               END DO 
     219               ptsd(ji,jj,jpk,jp_tem) = 0._wp 
     220               ptsd(ji,jj,jpk,jp_sal) = 0._wp 
     221            END DO 
    251222         END DO 
    252          ! 
    253          ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) *tmask(:,:,:) 
    254          ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) *tmask(:,:,:) 
     223         !  
     224         CALL wrk_dealloc( jpk, ztp, zsp ) 
     225         !  
    255226      ELSE                                !==   z- or zps- coordinate   ==! 
    256227         !                              
    257          ptsd(:,:,:,jp_tem) = sf_tsd(jp_tem)%fnow(:,:,:)  * tmask(:,:,:)  ! Mask 
    258          ptsd(:,:,:,jp_sal) = sf_tsd(jp_sal)%fnow(:,:,:) * tmask(:,:,:) 
     228         ptsd(:,:,:,jp_tem) = ptsd(:,:,:,jp_tem) * tmask(:,:,:)    ! Mask 
     229         ptsd(:,:,:,jp_sal) = ptsd(:,:,:,jp_sal) * tmask(:,:,:) 
    259230         ! 
    260231         IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     
    286257                                        DEALLOCATE( sf_tsd(jp_sal)%fnow )     ! S arrays in the structure 
    287258         IF( sf_tsd(jp_sal)%ln_tint )   DEALLOCATE( sf_tsd(jp_sal)%fdta ) 
    288          IF( ln_tsd_interp )            DEALLOCATE( sf_tsd(jp_dep)%fnow )     ! T arrays in the structure 
    289          IF( ln_tsd_interp )            DEALLOCATE( sf_tsd(jp_msk)%fnow )     ! T arrays in the structure 
    290259                                        DEALLOCATE( sf_tsd              )     ! the structure itself 
    291260      ENDIF 
  • branches/UKMO/r8395_India_uncoupled/NEMOGCM/NEMO/OPA_SRC/par_oce.F90

    r10685 r10724  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_tem = 1    !: indice for temperature 
    6969   INTEGER, PUBLIC, PARAMETER ::   jp_sal = 2    !: indice for salinity 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_dep = 3    !: indice for depth 
    71    INTEGER, PUBLIC, PARAMETER ::   jp_msk = 4    !: indice for depth 
    7270 
    7371   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.