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.
Changeset 459 for trunk/NEMO/OPA_SRC/DTA – NEMO

Changeset 459 for trunk/NEMO/OPA_SRC/DTA


Ignore:
Timestamp:
2006-05-10T19:09:01+02:00 (18 years ago)
Author:
opalod
Message:

nemo_v1_update_050:RB: update dtasal and dtatem according to the new coordinate definition

Location:
trunk/NEMO/OPA_SRC/DTA
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OPA_SRC/DTA/dtasal.F90

    r440 r459  
    7575 
    7676      INTEGER, PARAMETER ::   jpmois = 12, jpf = 1 
    77       INTEGER ::   ji, jj, jl           ! dummy loop indicies 
     77      INTEGER ::   ji, jj, jl, jkk  ! dummy loop indicies 
     78      REAL(wp), DIMENSION(jpk,2) ::   & 
     79         zsaldta            ! auxiliary array for interpolation 
     80 
    7881      INTEGER ::   & 
    7982         imois, iman, ik, i15,       &  ! temporary integers 
    … …  
    9194      !!---------------------------------------------------------------------- 
    9295 
    93       ! 0. Initialization 
    94       ! ----------------- 
    95  
    96       iman  = jpmois 
    97       i15   = nday / 16 
    98  
    99       imois = nmonth + i15 - 1 
    100       IF( imois == 0 ) imois = iman 
    101  
    102       itime = jpmois 
    103       ipi=jpiglo 
    104       ipj=jpjglo 
    105       ipk = jpk 
    106  
    107       ! 1. First call kt=nit000 
    108       ! ----------------------- 
    109  
    110       IF( kt == nit000 .AND. nlecsa == 0 ) THEN 
    111          nsal1 = 0 
    112          IF(lwp) THEN 
    113             WRITE(numout,*) 
    114             WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
    115             WRITE(numout,*) ' ~~~~~~~' 
    116             WRITE(numout,*) 
    117          ENDIF 
    118  
    119          ! open file 
    120           
    121          clname = 'data_1m_salinity_nomask' 
     96     ! 0. Initialization 
     97     ! ----------------- 
     98 
     99     iman  = jpmois 
     100     i15   = nday / 16 
     101 
     102     imois = nmonth + i15 - 1 
     103     IF( imois == 0 ) imois = iman 
     104 
     105     itime = jpmois 
     106     ipi=jpiglo 
     107     ipj=jpjglo 
     108     ipk = jpk 
     109 
     110     ! 1. First call kt=nit000 
     111     ! ----------------------- 
     112 
     113     IF( kt == nit000 .AND. nlecsa == 0 ) THEN 
     114   nsal1 = 0 
     115   IF(lwp) THEN 
     116      WRITE(numout,*) 
     117      WRITE(numout,*) ' dta_sal : monthly salinity data in NetCDF file' 
     118      WRITE(numout,*) ' ~~~~~~~' 
     119      WRITE(numout,*) 
     120   ENDIF 
     121 
     122   ! open file 
     123 
     124   clname = 'data_1m_salinity_nomask' 
    122125#if defined key_agrif 
    123          if ( .NOT. Agrif_Root() ) then 
    124             clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
    125          endif 
    126 #endif           
    127          CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   & 
    128               ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt) 
    129  
    130          ! title, dimensions and tests 
    131  
    132          IF( itime /= jpmois ) THEN 
    133             IF(lwp) THEN 
    134                WRITE(numout,*) 
    135                WRITE(numout,*) 'problem with time coordinates' 
    136                WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    137             ENDIF 
    138             STOP 'dta_sal' 
    139          ENDIF 
    140          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    141             IF(lwp) THEN 
    142                WRITE(numout,*) 
    143                WRITE(numout,*) 'problem with dimensions' 
    144                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    145                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    146                WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    147             ENDIF 
    148             STOP 'dta_sal' 
    149          ENDIF 
    150          IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt 
    151  
    152       ENDIF 
    153  
    154  
    155       ! 2. Read monthly file 
    156       ! ------------------- 
    157  
    158       IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN 
    159          nlecsa = 1 
    160           
    161          ! 2.1 Calendar computation 
    162           
    163          nsal1 = imois        ! first file record used  
    164          nsal2 = nsal1 + 1    ! last  file record used 
    165          nsal1 = MOD( nsal1, iman ) 
    166          IF( nsal1 == 0 ) nsal1 = iman 
    167          nsal2 = MOD( nsal2, iman ) 
    168          IF( nsal2 == 0 ) nsal2 = iman 
    169          IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
    170          IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
    171           
    172          ! 2.3 Read monthly salinity data Levitus  
    173  
    174          CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   & 
    175            nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1)) 
    176  
    177          CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   & 
    178            nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2)) 
    179  
    180           
    181          IF(lwp) THEN 
    182             WRITE(numout,*) 
    183             WRITE(numout,*) ' read Levitus salinity ok' 
    184             WRITE(numout,*) 
    185          ENDIF 
    186           
     126   if ( .NOT. Agrif_Root() ) then 
     127      clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) 
     128   endif 
     129#endif              
     130   CALL flinopen(TRIM(clname),mig(1),nlci,mjg(1),nlcj,.FALSE.   & 
     131        ,ipi,ipj,ipk,zlon,zlat,zlev,itime,istep,zdate0,rdt,numsdt) 
     132 
     133   ! title, dimensions and tests 
     134 
     135   IF( itime /= jpmois ) THEN 
     136      IF(lwp) THEN 
     137         WRITE(numout,*) 
     138         WRITE(numout,*) 'problem with time coordinates' 
     139         WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
     140      ENDIF 
     141      STOP 'dta_sal' 
     142   ENDIF 
     143   IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
     144      IF(lwp) THEN 
     145         WRITE(numout,*) 
     146         WRITE(numout,*) 'problem with dimensions' 
     147         WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
     148         WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
     149         WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
     150      ENDIF 
     151      STOP 'dta_sal' 
     152   ENDIF 
     153   IF(lwp)WRITE(numout,*) itime,istep,zdate0,rdt,numsdt 
     154 
     155     ENDIF 
     156 
     157 
     158     ! 2. Read monthly file 
     159     ! ------------------- 
     160 
     161     IF( ( kt == nit000 .AND. nlecsa == 0) .OR. imois /= nsal1 ) THEN 
     162   nlecsa = 1 
     163 
     164   ! 2.1 Calendar computation 
     165 
     166   nsal1 = imois        ! first file record used  
     167   nsal2 = nsal1 + 1    ! last  file record used 
     168   nsal1 = MOD( nsal1, iman ) 
     169   IF( nsal1 == 0 ) nsal1 = iman 
     170   nsal2 = MOD( nsal2, iman ) 
     171   IF( nsal2 == 0 ) nsal2 = iman 
     172   IF(lwp) WRITE(numout,*) 'first record file used nsal1 ', nsal1 
     173   IF(lwp) WRITE(numout,*) 'last  record file used nsal2 ', nsal2 
     174 
     175   ! 2.3 Read monthly salinity data Levitus  
     176 
     177   CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal1,   & 
     178     nsal1,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,1)) 
     179 
     180   CALL flinget(numsdt,'vosaline',jpidta,jpjdta,jpk,jpmois,nsal2,   & 
     181     nsal2,mig(1),nlci,mjg(1),nlcj,saldta(1:nlci,1:nlcj,1:jpk,2)) 
     182 
     183 
     184   IF(lwp) THEN 
     185      WRITE(numout,*) 
     186      WRITE(numout,*) ' read Levitus salinity ok' 
     187      WRITE(numout,*) 
     188   ENDIF 
     189 
    187190#if defined key_tradmp 
    188          IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    189  
    190             !                                        ! ======================= 
    191             !                                        !  ORCA_R2 configuration 
    192             !                                        ! ======================= 
    193             ij0 = 101   ;   ij1 = 109 
    194             ii0 = 141   ;   ii1 = 155    
    195             DO jj = mj0(ij0), mj1(ij1)                      ! Reduced salinity in the Alboran Sea 
    196                DO ji = mi0(ii0), mi1(ii1) 
    197                   DO jk = 13, 13 
    198                      saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15 
    199                   END DO 
    200                   DO jk = 14, 15 
    201                      saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25 
    202                   END DO 
    203                   DO jk = 16, 17 
    204                      saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30 
    205                   END DO 
    206                   DO jk = 18, 25 
    207                      saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35 
    208                   END DO 
    209                END DO 
    210             END DO 
    211             IF( n_cla == 1 ) THEN  
    212                !                                         ! New salinity profile at Gibraltar 
    213                il0 = 138   ;   il1 = 138    
    214                ij0 = 101   ;   ij1 = 101 
    215                ii0 = 139   ;   ii1 = 139    
    216                saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
    217                   &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
    218                ij0 = 101   ;   ij1 = 101 
    219                saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
    220                   &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
    221                il0 = 138   ;   il1 = 138    
    222                ij0 = 101   ;   ij1 = 102 
    223                ii0 = 139   ;   ii1 = 139    
    224                DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Gibraltar 
    225                   DO jj = mj0(ij0), mj1(ij1) 
    226                      DO ji = mi0(ii0), mi1(ii1) 
    227                         saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    228                      END DO 
    229                   END DO 
    230                END DO 
    231  
    232                il0 = 164   ;   il1 = 164    
    233                ij0 =  88   ;   ij1 =  88 
    234                ii0 = 161   ;   ii1 = 163    
    235                DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Bab el Mandeb 
    236                   DO jj = mj0(ij0), mj1(ij1) 
    237                      DO ji = mi0(ii0), mi1(ii1) 
    238                         saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    239                      END DO 
    240                   END DO 
    241                   ij0 =  87   ;   ij1 =  87 
    242                   DO jj = mj0(ij0), mj1(ij1) 
    243                      DO ji = mi0(ii0), mi1(ii1) 
    244                         saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
    245                      END DO 
    246                   END DO 
    247                END DO 
    248  
    249             ENDIF 
    250  
    251          ENDIF 
    252 #endif 
    253           
    254          !                                     ! Mask 
    255          DO jl = 1, 2 
    256             saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 
    257             saldta(:,:,jpk,jl) = 0. 
    258             IF( lk_zps ) THEN                   ! z-coord. partial steps 
    259                DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step) 
    260                   DO ji = 1, jpi 
    261                      ik = mbathy(ji,jj) - 1 
    262                      IF( ik > 2 ) THEN 
    263                         zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 
    264                         saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl)  
    265                      ENDIF 
    266                   END DO 
    267                END DO 
    268             ENDIF 
    269          END DO 
    270           
    271  
    272          IF(lwp) THEN 
    273             WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 
    274             WRITE(numout,*) 
    275             WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
    276             CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    277             WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
    278             CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    279             WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
    280             CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
    281          ENDIF 
    282       ENDIF 
    283        
    284   
    285       ! 3. At every time step compute salinity data 
    286       ! ------------------------------------------- 
    287  
    288       zxy = FLOAT(nday + 15 - 30*i15)/30. 
    289       s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 
     191   IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     192 
     193      !                                        ! ======================= 
     194      !                                        !  ORCA_R2 configuration 
     195      !                                        ! ======================= 
     196      ij0 = 101   ;   ij1 = 109 
     197      ii0 = 141   ;   ii1 = 155    
     198      DO jj = mj0(ij0), mj1(ij1)                      ! Reduced salinity in the Alboran Sea 
     199         DO ji = mi0(ii0), mi1(ii1) 
     200       DO jk = 13, 13 
     201          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.15 
     202       END DO 
     203       DO jk = 14, 15 
     204          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.25 
     205       END DO 
     206       DO jk = 16, 17 
     207          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.30 
     208       END DO 
     209       DO jk = 18, 25 
     210          saldta(ji,jj,jk,:) = saldta(ji,jj,jk,:) - 0.35 
     211       END DO 
     212         END DO 
     213      END DO 
     214      IF( n_cla == 1 ) THEN  
     215         !                                         ! New salinity profile at Gibraltar 
     216         il0 = 138   ;   il1 = 138    
     217         ij0 = 101   ;   ij1 = 101 
     218         ii0 = 139   ;   ii1 = 139    
     219         saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     220       &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     221         ij0 = 101   ;   ij1 = 101 
     222         saldta( mi0(ii0):mi1(ii1), mj0(ij0):mj1(ij1) , : , : ) =   & 
     223       &                                    saldta( mi0(il0):mi1(il1) , mj0(ij0):mj1(ij1) , : , : ) 
     224         il0 = 138   ;   il1 = 138    
     225         ij0 = 101   ;   ij1 = 102 
     226         ii0 = 139   ;   ii1 = 139    
     227         DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Gibraltar 
     228       DO jj = mj0(ij0), mj1(ij1) 
     229          DO ji = mi0(ii0), mi1(ii1) 
     230             saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     231          END DO 
     232       END DO 
     233         END DO 
     234 
     235         il0 = 164   ;   il1 = 164    
     236         ij0 =  88   ;   ij1 =  88 
     237         ii0 = 161   ;   ii1 = 163    
     238         DO jl = mi0(il0), mi1(il1)                ! New salinity profile at Bab el Mandeb 
     239       DO jj = mj0(ij0), mj1(ij1) 
     240          DO ji = mi0(ii0), mi1(ii1) 
     241             saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     242          END DO 
     243       END DO 
     244       ij0 =  87   ;   ij1 =  87 
     245       DO jj = mj0(ij0), mj1(ij1) 
     246          DO ji = mi0(ii0), mi1(ii1) 
     247             saldta(ji,jj,:,:) = saldta(jl,jj,:,:) 
     248          END DO 
     249       END DO 
     250         END DO 
     251 
     252      ENDIF 
     253 
     254   ENDIF 
     255#endif    
     256 
     257     IF( ln_sco ) THEN 
     258     DO jl = 1, 2 
     259   DO jj = 1, jpj                  ! interpolation of salinites 
     260      DO ji = 1, jpi 
     261         DO jk = 1, jpk 
     262        zl=fsdept(ji,jj,jk) 
     263        IF(zl <  gdept_0(1)) zsaldta(jk,jl) =  saldta(ji,jj,1,jl) 
     264        IF(zl >  gdept_0(jpk)) zsaldta(jk,jl) =  saldta(ji,jj,jpkm1,jl) 
     265        DO jkk = 1, jpkm1 
     266            IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     267           zsaldta(jk,jl) = saldta(ji,jj,jkk,jl)                                  & 
     268              &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))       & 
     269              &                              *(saldta(ji,jj,jkk+1,jl) - saldta(ji,jj,jkk,jl)) 
     270            ENDIF 
     271        END DO 
     272         END DO 
     273         DO jk = 1, jpkm1 
     274             saldta(ji,jj,jk,jl) = zsaldta(jk,jl) 
     275         END DO 
     276             saldta(ji,jj,jpk,jl) = 0.0 
     277      END DO 
     278   END DO 
     279     END DO 
     280 
     281     IF(lwp) WRITE(numout,*) 
     282     IF(lwp) WRITE(numout,*) ' Levitus salinity data interpolated to s-coordinate' 
     283     IF(lwp) WRITE(numout,*) 
     284 
     285     ELSE 
     286     !                                     ! Mask 
     287     DO jl = 1, 2 
     288   saldta(:,:,:,jl) = saldta(:,:,:,jl)*tmask(:,:,:) 
     289   saldta(:,:,jpk,jl) = 0. 
     290   IF( ln_zps ) THEN                   ! z-coord. partial steps 
     291      DO jj = 1, jpj                           ! interpolation of salinity at the last ocean level (i.e. the partial step) 
     292         DO ji = 1, jpi 
     293       ik = mbathy(ji,jj) - 1 
     294       IF( ik > 2 ) THEN 
     295          zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     296          saldta(ji,jj,ik,jl) = (1.-zl) * saldta(ji,jj,ik,jl) +zl * saldta(ji,jj,ik-1,jl) 
     297       ENDIF 
     298         END DO 
     299      END DO 
     300   ENDIF 
     301     END DO 
     302     ENDIF 
     303 
     304 
     305   IF(lwp) THEN 
     306      WRITE(numout,*)' salinity Levitus month ',nsal1,nsal2 
     307      WRITE(numout,*) 
     308      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = 1' 
     309      CALL prihre(saldta(:,:,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     310      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpk/2 
     311      CALL prihre(saldta(:,:,jpk/2,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     312      WRITE(numout,*) ' Levitus month = ',nsal1,'  level = ',jpkm1 
     313      CALL prihre(saldta(:,:,jpkm1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout) 
     314   ENDIF 
     315     ENDIF 
     316 
     317 
     318     ! 3. At every time step compute salinity data 
     319     ! ------------------------------------------- 
     320 
     321     zxy = FLOAT(nday + 15 - 30*i15)/30. 
     322     s_dta(:,:,:) = ( 1.- zxy ) * saldta(:,:,:,1) + zxy * saldta(:,:,:,2) 
    290323 
    291324   END SUBROUTINE dta_sal 

  • trunk/NEMO/OPA_SRC/DTA/dtatem.F90

    r440 r459  
    8383      INTEGER, PARAMETER ::   & 
    8484         jpmois = 12                    ! number of month 
    85       INTEGER ::   ji, jj, jl           ! dummy loop indicies 
     85      INTEGER ::   ji, jj, jk, jl, jkk  ! dummy loop indicies 
     86      REAL(wp), DIMENSION(jpk,2) ::   & 
     87         ztemdta            ! auxiliary array for interpolation 
     88 
    8689      INTEGER ::   & 
    8790         imois, iman, itime, ik ,    &  ! temporary integers 
    … …  
    98101      !!---------------------------------------------------------------------- 
    99102 
    100       ! 0. Initialization 
    101       ! ----------------- 
    102  
    103       iman  = jpmois 
    104       i15   = nday / 16 
    105       imois = nmonth + i15 - 1 
    106       IF( imois == 0 )   imois = iman 
    107  
    108       itime = jpmois 
    109       ipi = jpiglo 
    110       ipj = jpjglo 
    111       ipk = jpk 
    112  
    113       ! 1. First call kt=nit000 
    114       ! ----------------------- 
    115  
    116       IF( kt == nit000 .AND. nlecte == 0 ) THEN 
    117          ntem1 = 0 
    118          IF(lwp) WRITE(numout,*) 
    119          IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 
    120          IF(lwp) WRITE(numout,*) ' ~~~~~~' 
    121          IF(lwp) WRITE(numout,*) '             NetCDF FORMAT' 
    122          IF(lwp) WRITE(numout,*) 
    123           
    124          ! open file 
    125  
    126          cl_tdata = 'data_1m_potential_temperature_nomask ' 
     103     ! 0. Initialization 
     104     ! ----------------- 
     105 
     106     iman  = jpmois 
     107     i15   = nday / 16 
     108     imois = nmonth + i15 - 1 
     109     IF( imois == 0 )   imois = iman 
     110 
     111     itime = jpmois 
     112     ipi = jpiglo 
     113     ipj = jpjglo 
     114     ipk = jpk 
     115 
     116     ! 1. First call kt=nit000 
     117     ! ----------------------- 
     118 
     119     IF( kt == nit000 .AND. nlecte == 0 ) THEN 
     120   ntem1 = 0 
     121   IF(lwp) WRITE(numout,*) 
     122   IF(lwp) WRITE(numout,*) ' dtatem : Levitus monthly fields' 
     123   IF(lwp) WRITE(numout,*) ' ~~~~~~' 
     124   IF(lwp) WRITE(numout,*) '             NetCDF FORMAT' 
     125   IF(lwp) WRITE(numout,*) 
     126 
     127   ! open file 
     128 
     129   cl_tdata = 'data_1m_potential_temperature_nomask ' 
    127130#if defined key_agrif 
    128          if ( .NOT. Agrif_Root() ) then 
    129             cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 
    130          endif 
    131 #endif          
    132          CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   & 
    133             &          , .false.     , ipi   , ipj  , ipk   , zlon     & 
    134             &          , zlat        , zlev  , itime, istep , zdate0   & 
    135             &          , rdt         , numtdt                        ) 
    136  
    137          ! title, dimensions and tests 
    138  
    139          IF( itime /= jpmois ) THEN 
    140             IF(lwp) THEN 
    141                WRITE(numout,*) 
    142                WRITE(numout,*) 'problem with time coordinates' 
    143                WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
    144             ENDIF 
    145             STOP 'dtatem' 
    146          ENDIF 
    147          IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
    148             IF(lwp) THEN 
    149                WRITE(numout,*) 
    150                WRITE(numout,*) 'problem with dimensions' 
    151                WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
    152                WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
    153                WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
    154             ENDIF 
    155             STOP 'dtatem' 
    156          ENDIF 
    157          IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 
    158  
    159       ENDIF 
    160  
    161  
    162       ! 2. Read monthly file 
    163       ! ------------------- 
    164  
    165       IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 
    166          nlecte = 1 
    167  
    168          ! Calendar computation 
    169           
    170          ntem1 = imois        ! first file record used  
    171          ntem2 = ntem1 + 1    ! last  file record used 
    172          ntem1 = MOD( ntem1, iman ) 
    173          IF( ntem1 == 0 )   ntem1 = iman 
    174          ntem2 = MOD( ntem2, iman ) 
    175          IF( ntem2 == 0 )   ntem2 = iman 
    176          IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 
    177          IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2 
    178           
    179          ! Read monthly temperature data Levitus  
    180           
    181          CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
    182                      , jpmois, ntem1     , ntem1 , mig(1), nlci   & 
    183                      , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     ) 
    184          CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
    185                      , jpmois, ntem2     , ntem2 , mig(1), nlci   & 
    186                      , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     ) 
    187  
    188          IF(lwp) WRITE(numout,*) 
    189          IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 
    190          IF(lwp) WRITE(numout,*) 
    191           
     131   if ( .NOT. Agrif_Root() ) then 
     132      cl_tdata = TRIM(Agrif_CFixed())//'_'//TRIM(cl_tdata) 
     133   endif 
     134#endif             
     135   CALL flinopen( TRIM(cl_tdata), mig(1), nlci , mjg(1),  nlcj   & 
     136      &          , .false.     , ipi   , ipj  , ipk   , zlon     & 
     137      &          , zlat        , zlev  , itime, istep , zdate0   & 
     138      &          , rdt         , numtdt                        ) 
     139 
     140   ! title, dimensions and tests 
     141 
     142   IF( itime /= jpmois ) THEN 
     143      IF(lwp) THEN 
     144         WRITE(numout,*) 
     145         WRITE(numout,*) 'problem with time coordinates' 
     146         WRITE(numout,*) ' itime ',itime,' jpmois ',jpmois 
     147      ENDIF 
     148      STOP 'dtatem' 
     149   ENDIF 
     150   IF( ipi /= jpidta .OR. ipj /= jpjdta .OR. ipk /= jpk ) THEN 
     151      IF(lwp) THEN 
     152         WRITE(numout,*) 
     153         WRITE(numout,*) 'problem with dimensions' 
     154         WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta 
     155         WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta 
     156         WRITE(numout,*) ' ipk ',ipk,' jpk ',jpk 
     157      ENDIF 
     158      STOP 'dtatem' 
     159   ENDIF 
     160   IF(lwp) WRITE(numout,*) itime,istep,zdate0,rdt,numtdt 
     161 
     162     ENDIF 
     163 
     164 
     165     ! 2. Read monthly file 
     166     ! ------------------- 
     167 
     168     IF( ( kt == nit000 .AND. nlecte == 0 ) .OR. imois /= ntem1 ) THEN 
     169   nlecte = 1 
     170 
     171   ! Calendar computation 
     172 
     173   ntem1 = imois        ! first file record used  
     174   ntem2 = ntem1 + 1    ! last  file record used 
     175   ntem1 = MOD( ntem1, iman ) 
     176   IF( ntem1 == 0 )   ntem1 = iman 
     177   ntem2 = MOD( ntem2, iman ) 
     178   IF( ntem2 == 0 )   ntem2 = iman 
     179   IF(lwp) WRITE(numout,*) 'first record file used ntem1 ', ntem1 
     180   IF(lwp) WRITE(numout,*) 'last  record file used ntem2 ', ntem2 
     181 
     182   ! Read monthly temperature data Levitus  
     183 
     184   CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
     185          , jpmois, ntem1     , ntem1 , mig(1), nlci   & 
     186          , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,1)     ) 
     187   CALL flinget( numtdt, 'votemper', jpidta, jpjdta, jpk   & 
     188          , jpmois, ntem2     , ntem2 , mig(1), nlci   & 
     189          , mjg(1), nlcj      , temdta(1:nlci,1:nlcj,1:jpk,2)     ) 
     190 
     191   IF(lwp) WRITE(numout,*) 
     192   IF(lwp) WRITE(numout,*) ' read Levitus temperature ok' 
     193   IF(lwp) WRITE(numout,*) 
     194 
    192195#if defined key_tradmp 
    193          IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
    194        
    195             !                                        ! ======================= 
    196             !                                        !  ORCA_R2 configuration 
    197             !                                        ! =======================  
    198  
    199             ij0 = 101   ;   ij1 = 109 
    200             ii0 = 141   ;   ii1 = 155 
    201             DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
    202                DO ji = mi0(ii0), mi1(ii1) 
    203                   temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
    204                   temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
    205                   temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 
    206                END DO 
    207             END DO 
    208           
    209             IF( n_cla == 0 ) THEN  
    210                !                                         ! Reduced temperature at Red Sea 
    211                ij0 =  87   ;   ij1 =  96 
    212                ii0 = 148   ;   ii1 = 160 
    213                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
    214                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
    215                temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
    216             ELSE 
    217                il0 = 138   ;   il1 = 138 
    218                ij0 = 101   ;   ij1 = 102 
    219                ii0 = 139   ;   ii1 = 139 
    220                DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar 
    221                   DO jj = mj0(ij0), mj1(ij1) 
    222                      DO ji = mi0(ii0), mi1(ii1) 
    223                         temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    224                      END DO 
    225                   END DO 
    226                END DO 
    227                il0 = 164   ;   il1 = 164 
    228                ij0 =  88   ;   ij1 =  88 
    229                ii0 = 161   ;   ii1 = 163 
    230                DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb 
    231                   DO jj = mj0(ij0), mj1(ij1) 
    232                      DO ji = mi0(ii0), mi1(ii1) 
    233                         temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    234                      END DO 
    235                   END DO 
    236                   ij0 =  87   ;   ij1 =  87 
    237                   DO jj = mj0(ij0), mj1(ij1) 
    238                      DO ji = mi0(ii0), mi1(ii1) 
    239                         temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
    240                      END DO 
    241                   END DO 
    242                END DO 
    243             ENDIF 
    244  
    245          ENDIF 
     196   IF( cp_cfg == "orca"  .AND. jp_cfg == 2 ) THEN 
     197 
     198      !                                        ! ======================= 
     199      !                                        !  ORCA_R2 configuration 
     200      !                                        ! =======================  
     201 
     202      ij0 = 101   ;   ij1 = 109 
     203      ii0 = 141   ;   ii1 = 155 
     204      DO jj = mj0(ij0), mj1(ij1)                      ! Reduced temperature in the Alboran Sea 
     205         DO ji = mi0(ii0), mi1(ii1) 
     206      temdta(ji,jj, 13:13 ,:) = temdta(ji,jj, 13:13 ,:) - 0.20 
     207      temdta(ji,jj, 14:15 ,:) = temdta(ji,jj, 14:15 ,:) - 0.35 
     208      temdta(ji,jj, 16:25 ,:) = temdta(ji,jj, 16:25 ,:) - 0.40 
     209         END DO 
     210      END DO 
     211 
     212      IF( n_cla == 0 ) THEN  
     213         !                                         ! Reduced temperature at Red Sea 
     214         ij0 =  87   ;   ij1 =  96 
     215         ii0 = 148   ;   ii1 = 160 
     216         temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ,  4:10 , : ) = 7.0  
     217         temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 11:13 , : ) = 6.5  
     218         temdta( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) , 14:20 , : ) = 6.0 
     219      ELSE 
     220         il0 = 138   ;   il1 = 138 
     221         ij0 = 101   ;   ij1 = 102 
     222         ii0 = 139   ;   ii1 = 139 
     223         DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Gibraltar 
     224      DO jj = mj0(ij0), mj1(ij1) 
     225          DO ji = mi0(ii0), mi1(ii1) 
     226             temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     227          END DO 
     228      END DO 
     229         END DO 
     230         il0 = 164   ;   il1 = 164 
     231         ij0 =  88   ;   ij1 =  88 
     232         ii0 = 161   ;   ii1 = 163 
     233         DO jl = mi0(il0), mi1(il1)                ! New temperature profile at Bab el Mandeb 
     234      DO jj = mj0(ij0), mj1(ij1) 
     235          DO ji = mi0(ii0), mi1(ii1) 
     236             temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     237          END DO 
     238      END DO 
     239      ij0 =  87   ;   ij1 =  87 
     240      DO jj = mj0(ij0), mj1(ij1) 
     241          DO ji = mi0(ii0), mi1(ii1) 
     242             temdta(ji,jj,:,:) = temdta(jl,jj,:,:) 
     243          END DO 
     244      END DO 
     245         END DO 
     246      ENDIF 
     247 
     248   ENDIF 
    246249#endif 
    247250 
    248          !                                  ! Mask 
    249          DO jl = 1, 2 
    250             temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 
    251             temdta(:,:,jpk,jl) = 0. 
    252             IF( lk_zps ) THEN                ! z-coord. with partial steps 
    253                DO jj = 1, jpj                  ! interpolation of temperature at the last level 
    254                   DO ji = 1, jpi 
    255                      ik = mbathy(ji,jj) - 1 
    256                      IF( ik > 2 ) THEN 
    257                         zl = ( gdept(ik) - fsdept(ji,jj,ik) ) / ( gdept(ik) - gdept(ik-1) ) 
    258                         temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl)  
    259                      ENDIF 
    260                   END DO 
    261                END DO 
    262             ENDIF 
    263          END DO 
    264  
    265          IF(lwp) THEN 
    266             WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 
    267             WRITE(numout,*) 
    268             WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
    269             CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    270             WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
    271             CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    272             WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
    273             CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
    274          ENDIF 
    275       ENDIF 
    276  
    277   
    278       ! 2. At every time step compute temperature data 
    279       ! ---------------------------------------------- 
    280  
    281       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    282       t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
    283  
     251     IF( ln_sco ) THEN 
     252     DO jl = 1, 2 
     253   DO jj = 1, jpj                  ! interpolation of temperatures 
     254      DO ji = 1, jpi 
     255         DO jk = 1, jpk 
     256        zl=fsdept(ji,jj,jk) 
     257        IF(zl < gdept_0(1)) ztemdta(jk,jl) =  temdta(ji,jj,1,jl) 
     258        IF(zl > gdept_0(jpk)) ztemdta(jk,jl) =  temdta(ji,jj,jpkm1,jl) 
     259        DO jkk = 1, jpkm1 
     260            IF((zl-gdept_0(jkk))*(zl-gdept_0(jkk+1)).le.0.0) THEN 
     261           ztemdta(jk,jl) = temdta(ji,jj,jkk,jl)                                 & 
     262              &           + (zl-gdept_0(jkk))/(gdept_0(jkk+1)-gdept_0(jkk))      & 
     263              &                              *(temdta(ji,jj,jkk+1,jl) - temdta(ji,jj,jkk,jl)) 
     264            ENDIF 
     265        END DO 
     266         END DO 
     267         DO jk = 1, jpkm1 
     268             temdta(ji,jj,jk,jl) = ztemdta(jk,jl) 
     269         END DO 
     270             temdta(ji,jj,jpk,jl) = 0.0 
     271      END DO 
     272   END DO 
     273     END DO 
     274 
     275     IF(lwp) WRITE(numout,*) 
     276     IF(lwp) WRITE(numout,*) ' Levitus temperature data interpolated to s-coordinate' 
     277     IF(lwp) WRITE(numout,*) 
     278 
     279     ELSE 
     280 
     281     !                                  ! Mask 
     282     DO jl = 1, 2 
     283   temdta(:,:,:,jl) = temdta(:,:,:,jl) * tmask(:,:,:) 
     284   temdta(:,:,jpk,jl) = 0. 
     285   IF( ln_zps ) THEN                ! z-coord. with partial steps 
     286      DO jj = 1, jpj                  ! interpolation of temperature at the last level 
     287         DO ji = 1, jpi 
     288       ik = mbathy(ji,jj) - 1 
     289       IF( ik > 2 ) THEN 
     290          zl = ( gdept_0(ik) - fsdept(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     291          temdta(ji,jj,ik,jl) = (1.-zl) * temdta(ji,jj,ik,jl) + zl * temdta(ji,jj,ik-1,jl) 
     292       ENDIF 
     293         END DO 
     294      END DO 
     295   ENDIF 
     296     END DO 
     297 
     298     ENDIF 
     299 
     300   IF(lwp) THEN 
     301      WRITE(numout,*) ' temperature Levitus month ', ntem1, ntem2 
     302      WRITE(numout,*) 
     303      WRITE(numout,*) ' Levitus month = ', ntem1, '  level = 1' 
     304      CALL prihre( temdta(:,:,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     305      WRITE(numout,*) ' Levitus month = ', ntem1, '  level = ', jpk/2 
     306      CALL prihre( temdta(:,:,jpk/2,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     307      WRITE(numout,*) ' Levitus month = ',ntem1,'  level = ', jpkm1 
     308      CALL prihre( temdta(:,:,jpkm1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     309   ENDIF 
     310     ENDIF 
     311 
     312 
     313     ! 2. At every time step compute temperature data 
     314     ! ---------------------------------------------- 
     315 
     316     zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
     317     t_dta(:,:,:) = (1.-zxy) * temdta(:,:,:,1) + zxy * temdta(:,:,:,2) 
    284318 
    285319   END SUBROUTINE dta_tem 
Note: See TracChangeset for help on using the changeset viewer.