Changeset 4427


Ignore:
Timestamp:
2014-02-04T13:14:00+01:00 (7 years ago)
Author:
trackstand2
Message:

First files changed on last FINISS work package. Stephen's work although
commited by Andy P.

Location:
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/dommsk.F90

    r3211 r4427  
    203203#endif 
    204204!!gm end 
     205 
     206!! smp FINISS  
     207#if defined key_z_first 
     208      ! Reset mbkmax to be the first level for which tmask is zero 
     209      DO jj = 1, jpj 
     210         DO ji = 1, jpi 
     211            mbkmax(ji,jj) = 1  
     212            kloop: DO jk = 1, jpkorig 
     213               IF (tmask(ji,jj,jk) == 0.0_wp) THEN 
     214                  mbkmax(ji,jj) = jk 
     215                  EXIT kloop 
     216               END IF  
     217            END DO kloop 
     218            IF (mbkmax(ji,jj) > jpk) THEN 
     219               WRITE (*,*) 'FINISS error: mbkmax(',ji,',',jj,') > jpk (',jpk,') on subdomain ',narea 
     220               mbkmax(ji,jj) = jpk 
     221            END IF 
     222         END DO 
     223      END DO 
     224#endif 
    205225 
    206226      ! Interior domain mask (used for global sum) 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90

    r4409 r4427  
    131131      ! ----------------------------------- 
    132132      IF( lzoom       )   CALL zgr_bat_zoom     ! correct mbathy in case of zoom subdomain 
    133       IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isoated ocean points 
     133      IF( .NOT.lk_c1d )   CALL zgr_bat_ctl      ! check bathymetry (mbathy) and suppress isolated ocean points 
    134134                          CALL zgr_bot_level    ! deepest ocean level for t-, u- and v-points 
    135135      ! 
     
    819819      jpkorig = jpk 
    820820      IF( domtrim_z ) THEN 
    821          mbkmax(:,:) = MAX(mbkt(:,:)+1, mbku(:,:), mbkv(:,:)) 
    822 !         jpkf = MIN(jpk, 1 + MAXVAL( mbkmax(:,:) ) ) 
     821!        mbkmax(:,:) = MAX(mbkt(:,:)+1, mbku(:,:), mbkv(:,:)) 
     822!        write(*,*) narea, ': SMPDBG: ji, jj, mbkt(ji,jj), mbku(ji,jj), mbkv(ji,jj), mbkmax(ji,jj)' 
     823         DO jj = 1, jpj 
     824            DO ji = 1, jpi 
     825               mbkmax(ji,jj) = MIN(jpk, MAX(mbkt(ji,jj)+1, mbku(ji,jj), mbkv(ji,jj))) 
     826               ! write(*,*) narea, ': SMPDBG: ', ji, jj, mbkt(ji,jj), mbku(ji,jj), mbkv(ji,jj), mbkmax(ji,jj) 
     827            END DO 
     828         END DO 
    823829         jpkf = MAXVAL( mbkmax(:,:) ) 
    824830         WRITE(*,*) narea,': ARPDBG: shallowest pt and jpkf = ', & 
     
    830836      ELSE 
    831837         WRITE(*,*) narea,': ARPDBG: NOT trimming domain in z' 
     838         mbkmax(:,:) = jpk 
    832839         jpkf = jpk 
    833840      END IF 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynkeg.F90

    r3432 r4427  
    8787      DO jj = 2, jpj            ! Horizontal kinetic energy at T-point 
    8888         DO ji = 2, jpi 
    89             DO jk = 1, jpkm1 
     89            DO jk = 1, mbkmax(ji,jj)-1 
    9090               zhke(ji,jj,jk) = 0.25 * (   un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    9191                  &                      + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk)   & 
    92                                          + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     92                  &                      + vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    9393                  &                      + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk)   ) 
    9494            END DO   
     
    9797      DO jj = 2, jpjm1          ! add the gradient of kinetic energy to the general momentum trends 
    9898         DO ji = 2, jpim1 
    99             DO jk = 1, jpkm1 
     99            DO jk = 1, mbkmax(ji,jj)-1 
    100100               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    101101               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_lap.F90

    r3211 r4427  
    8383      DO jj = 2, jpjm1 
    8484         DO ji = 2, jpim1 
    85             DO jk = 1, jpkm1 
     85            DO jk = 1, mbkmax(ji,jj)-1 
    8686#else 
    8787      !                                                ! =============== 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynzad.F90

    r3837 r4427  
    9999            zwuw(ji,jj, 1 ) = 0.e0     ! Surface values set to zero 
    100100            zwvw(ji,jj, 1 ) = 0.e0 
    101             DO jk = 2, jpkm1 
     101            DO jk = 2, mbkmax(ji,jj)-1 
    102102               zwuw(ji,jj,jk) =   ( zww(ji+1,jj  )*wn(ji+1,jj  ,jk) + zww(ji,jj)*wn(ji,jj,jk) )   & 
    103103                  &             * ( un(ji,jj,jk-1)-un(ji,jj,jk) )  
     
    105105                  &             * ( vn(ji,jj,jk-1)-vn(ji,jj,jk) ) 
    106106            END DO   
    107             zwuw(ji,jj,jpk) = 0.e0     ! Bottom values set to zero 
    108             zwvw(ji,jj,jpk) = 0.e0 
     107            zwuw(ji,jj,mbkmax(ji,jj)) = 0.e0     ! Bottom values set to zero 
     108            zwvw(ji,jj,mbkmax(ji,jj)) = 0.e0 
    109109         END DO    
    110110      END DO 
     
    136136      DO jj = 2, jpjm1              ! Vertical momentum advection at u- and v-points 
    137137         DO ji = 2, jpim1 
    138             DO jk = 1, jpkm1 
     138            DO jk = 1, mbkmax(ji,jj)-1 
    139139#else 
    140140      DO jk = 1, jpkm1              ! Vertical momentum advection at u- and v-points 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4415 r4427  
    9494      ! 
    9595      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     96#if defined key_z_first 
     97      INTEGER  ::   klim         ! upper bound on k loop 
     98#endif 
    9699      REAL(wp) ::   zcoefu, zcoefv, zcoeff, z2dt, z1_2dt, z1_rau0   ! local scalars 
    97100      !!---------------------------------------------------------------------- 
     
    107110         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    108111         ! 
     112#if defined key_z_first 
     113         DO jj=1,jpj 
     114            DO ji=1,jpi 
     115               DO jk=mbkmax(ji,jj), jpk 
     116                  wn(ji,jj,jk) = 0._wp 
     117               END DO 
     118            END DO 
     119         END DO 
     120#else 
    109121         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
     122#endif 
    110123         ! 
    111124         IF( lk_vvl ) THEN                    ! before and now Sea SSH at u-, v-, f-points (vvl case only) 
     
    161174            ! gdept_1(1:jpkm1,:,:) = (gdept(1:jpkm1,:,:)*(1.+sshn(:,:)*mut(1:jpkm1,:,:)))  
    162175            ! which contains non-conforming array expressions. 
    163          DO jj=1,jpj,1 
    164             DO ji=1,jpi,1 
    165                DO jk=1,jpk,1 
    166                   fsdept(ji,jj,jk) = fsdept_n(ji,jj,jk)   ! now local depths stored in fsdep. arrays 
    167                END DO 
    168             END DO 
    169          END DO 
    170          DO jj=1,jpj,1 
    171             DO ji=1,jpi,1 
    172                DO jk=1,jpk,1 
    173                   fsdepw(ji,jj,jk) = fsdepw_n(ji,jj,jk) 
    174                END DO 
    175             END DO 
    176          END DO 
    177          DO jj=1,jpj,1 
    178             DO ji=1,jpi,1 
    179                DO jk=1,jpk,1 
    180                   fsde3w(ji,jj,jk) = fsde3w_n(ji,jj,jk) 
    181                END DO 
    182             END DO 
    183          END DO 
    184             ! 
    185          DO jj=1,jpj,1 
    186             DO ji=1,jpi,1 
    187                DO jk=1,jpk,1 
    188                   fse3t (ji,jj,jk) = fse3t_n (ji,jj,jk)   ! vertical scale factors stored in fse3. arrays 
    189                END DO 
    190             END DO 
    191          END DO 
    192          DO jj=1,jpj,1 
    193             DO ji=1,jpi,1 
    194                DO jk=1,jpk,1 
    195                   fse3u (ji,jj,jk) = fse3u_n (ji,jj,jk) 
    196                END DO 
    197             END DO 
    198          END DO 
    199          DO jj=1,jpj,1 
    200             DO ji=1,jpi,1 
    201                DO jk=1,jpk,1 
    202                   fse3v (ji,jj,jk) = fse3v_n (ji,jj,jk) 
    203                END DO 
    204             END DO 
    205          END DO 
    206          DO jj=1,jpj,1 
    207             DO ji=1,jpi,1 
    208                DO jk=1,jpk,1 
    209                   fse3f (ji,jj,jk) = fse3f_n (ji,jj,jk) 
    210                END DO 
    211             END DO 
    212          END DO 
    213          DO jj=1,jpj,1 
    214             DO ji=1,jpi,1 
    215                DO jk=1,jpk,1 
    216                   fse3w (ji,jj,jk) = fse3w_n (ji,jj,jk) 
    217                END DO 
    218             END DO 
    219          END DO 
    220  
    221  
    222          DO jj=1,jpj,1 
    223             DO ji=1,jpi,1 
    224                DO jk=1,jpk,1 
    225                   fse3uw(ji,jj,jk) = fse3uw_n(ji,jj,jk) 
    226                END DO 
    227             END DO 
    228          END DO 
    229  
    230          DO jj=1,jpj,1 
    231             DO ji=1,jpi,1 
    232                DO jk=1,jpk,1 
    233                   fse3vw(ji,jj,jk) = fse3vw_n(ji,jj,jk) 
    234                END DO 
     176         DO jj=1,jpj 
     177            DO ji=1,jpi 
     178               klim=mbkmax(ji,jj) 
     179               ! now local depths stored in fsdep. arrays 
     180               fsdept(ji,jj,1:klim) = fsdept_n(ji,jj,1:klim) 
     181               fsdepw(ji,jj,1:klim) = fsdepw_n(ji,jj,1:klim) 
     182               fsde3w(ji,jj,1:klim) = fsde3w_n(ji,jj,1:klim) 
     183               ! vertical scale factors stored in fse3. arrays 
     184               fse3t (ji,jj,1:klim) = fse3t_n (ji,jj,1:klim) 
     185               fse3u (ji,jj,1:klim) = fse3u_n (ji,jj,1:klim) 
     186               fse3v (ji,jj,1:klim) = fse3v_n (ji,jj,1:klim) 
     187               fse3f (ji,jj,1:klim) = fse3f_n (ji,jj,1:klim) 
     188               fse3w (ji,jj,1:klim) = fse3w_n (ji,jj,1:klim) 
     189               fse3uw(ji,jj,1:klim) = fse3uw_n(ji,jj,1:klim) 
     190               fse3vw(ji,jj,1:klim) = fse3vw_n(ji,jj,1:klim) 
    235191            END DO 
    236192         END DO 
     
    279235      DO jj = 1, jpj 
    280236         DO ji = 1, jpi 
    281             DO jk = 1, jpkm1                           ! Horizontal divergence of barotropic transports 
     237            DO jk = 1, mbkmax(ji,jj)-1                 ! Horizontal divergence of barotropic transports 
    282238               zhdiv(ji,jj) = zhdiv(ji,jj) + fse3t(ji,jj,jk) * hdivn(ji,jj,jk) 
    283239            END DO 
     
    355311      DO jj = 1, jpj 
    356312         DO ji = 1, jpi 
    357             DO jk = jpkm1, 1, -1                      ! integrate from the bottom the hor. divergence 
     313            DO jk = mbkmax(ji,jj)-1, 1, -1                      ! integrate from the bottom the hor. divergence 
    358314                wn(ji,jj,jk) = wn(ji,jj,jk+1)                               & 
    359315                   &         -   fse3t_n(ji,jj,jk) * hdivn(ji,jj,jk)        & 
     
    390346         DO jj = 1, jpj 
    391347            DO ji = 1, jpi 
    392                DO jk = 1, jpk 
     348               DO jk = 1, mbkmax(ji,jj) 
    393349                  z3d(ji,jj,jk) = wn(ji,jj,jk) * z2d(ji,jj) 
    394350               END DO 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/LDF/ldfslp.F90

    r4409 r4427  
    815815      ! 
    816816      !                          !==   surface mixed layer mask   ! 
     817#if defined key_z_first 
     818      DO jj = 1, jpj 
     819         DO ji = 1, jpi 
     820            DO jk = 1, jpkf          ! =1 inside the mixed layer, =0 otherwise 
     821#else 
    817822      DO jk = 1, jpkf                ! =1 inside the mixed layer, =0 otherwise 
    818 # if ( defined key_vectopt_loop ) && ! ( defined key_z_first ) 
     823# if defined key_vectopt_loop  
    819824         DO jj = 1, 1 
    820825            DO ji = 1, jpij   ! vector opt. (forced unrolling) 
     
    823828            DO ji = 1, jpi 
    824829# endif 
     830#endif 
    825831               ik = nmln(ji,jj) - 1 
    826832               IF( jk <= ik ) THEN   ;   omlmask(ji,jj,jk) = 1._wp 
     
    967973            DO jj = 2, jpjm1 
    968974               DO ji = 2, jpim1 
    969                   DO jk = 1, jpkf 
     975                  DO jk = 1, mbkmax(ji,jj) 
    970976#else 
    971977            DO jk = 1, jpkf 
  • branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/TRA/traldf_iso.F90

    r4401 r4427  
    146146 
    147147#if defined key_z_first 
     148!! SMP Should not need to reserve or release 9 and 10 any more.  
    148149      IF( wrk_in_use(3, 6,7,8,9,10) .OR. wrk_in_use(2, 3) ) THEN 
    149150#else 
     
    162163      !                                                          ! =========== 
    163164!DIR$ SHORTLOOP 
     165 
     166#if defined key_z_first 
     167      zdit(:,:,:) = 0.0_wp 
     168      zdjt(:,:,:) = 0.0_wp 
     169#endif 
     170 
    164171      DO jn = 1, kjpt                                            ! tracer loop 
    165172         !                                                       ! =========== 
     
    169176         !!---------------------------------------------------------------------- 
    170177         !CALL timing_start('traldf_iso_I') 
     178 
     179         ! Horizontal tracer gradient  
     180#if defined key_z_first 
     181         DO jj = 1, jpjm1 
     182            DO ji = 1, jpim1 
     183               DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 
     184                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     185                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     186               END DO 
     187            END DO 
     188         END DO 
     189#else 
    171190         !!bug ajout.... why?   ( 1,jpj,:) and (jpi,1,:) should be sufficient.... 
    172 #if defined key_z_first 
    173          DO jj=1,jpj,1 
    174             DO jk=1,jpkf,1 
    175                zdit(1  ,jj,jk) = 0.0_wp 
    176                zdit(jpi,jj,jk) = 0.0_wp 
    177                zdjt(1  ,jj,jk) = 0.0_wp 
    178                zdjt(jpi,jj,jk) = 0.0_wp 
    179             END DO 
    180          END DO 
    181 #else 
    182191         zdit (1,:,1:jpkf) = 0.e0     ;     zdit (jpi,:,1:jpkf) = 0.e0 
    183192         zdjt (1,:,1:jpkf) = 0.e0     ;     zdjt (jpi,:,1:jpkf) = 0.e0 
    184 #endif 
    185193         !!end 
    186  
    187          ! Horizontal tracer gradient  
    188 #if defined key_z_first 
    189          DO jj = 1, jpjm1 
    190             DO ji = 1, jpim1 
    191                DO jk = 1, jpkfm1 ! jpkm1 
    192 #else 
    193194         DO jk = 1, jpkfm1 ! jpkm1 
    194195            DO jj = 1, jpjm1 
    195196               DO ji = 1, fs_jpim1   ! vector opt. 
    196 #endif 
    197197                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    198198                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     
    200200            END DO 
    201201         END DO 
     202#endif 
    202203         IF( ln_zps ) THEN      ! partial steps correction at the last ocean level  
    203204            DO jj = 1, jpjm1 
     
    257258         DO jj = 2 , jpjm1 
    258259            DO ji = 2, jpim1 
    259                DO jk = 1, jpkfm1 ! jpkm1 
     260               DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 
    260261 
    261262                  ! 1. Vertical tracer gradient at level jk and jk+1 
     
    392393            DO jj = 2, jpjm1 
    393394               DO ji = 2, jpim1 
    394                   DO jk = 1, jpkfm1 ! jpkm1 
     395                  DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 
    395396#else 
    396397            DO jk = 1, jpkfm1 ! jpkm1 
     
    409410            DO jj = 2, jpjm1 
    410411               DO ji = 2, jpim1 
    411                   DO jk = 1, jpkfm1 ! jpkm1 
     412                  DO jk = 1, mbkmax(ji,jj)-1 ! jpkm1 
    412413#else 
    413414            DO jk = 1, jpkfm1 ! jpkm1 
     
    433434         ! Local constant initialization 
    434435         ! ----------------------------- 
    435 #if defined key_z_first 
    436          DO jj=1,jpj,1 
    437             DO jk=1,jpkf,1 
    438                ztfw(1  ,jj,jk) = 0.0_wp 
    439                ztfw(jpi,jj,jk) = 0.0_wp 
    440             END DO 
    441          END DO 
    442 #else 
    443          ztfw(1,:,1:jpkf) = 0.e0     ;     ztfw(jpi,:,1:jpkf) = 0.e0 
    444 #endif 
    445436         ! Vertical fluxes 
    446437         ! --------------- 
     
    448439         ! Surface and bottom vertical fluxes set to zero 
    449440#if defined key_z_first 
    450          DO ji=1,jpi,1 
    451             DO jj=1,jpj,1 
    452                ztfw(ji,jj,1  ) = 0.0_wp 
    453                ztfw(ji,jj,jpkf) = 0.0_wp ! ARPDBG - should this be jpk anyway 
    454                                          ! since may be below ocean floor? 
    455             END DO 
    456          END DO 
    457 #else 
     441         ztfw(:,:,:) = 0.0_wp 
     442#else 
     443         ztfw(1,:,1:jpkf) = 0.e0     ;     ztfw(jpi,:,1:jpkf) = 0.e0 
    458444         ztfw(:,:, 1 ) = 0.e0      ;      ztfw(:,:,jpkf) = 0.e0 
    459445#endif 
     
    463449         DO jj = 2, jpjm1 
    464450            DO ji = 2, jpim1 
    465                DO jk = 2, jpkfm1 
     451               DO jk = 2, mbkmax(ji,jj)-1 
    466452#else 
    467453         DO jk = 2, jpkfm1 
     
    493479         DO jj = 2, jpjm1 
    494480            DO ji = 2, jpim1 
    495                DO jk = 1, jpkfm1 
     481               DO jk = 1, mbkmax(ji,jj)-1 
    496482#else 
    497483         DO jk = 1, jpkfm1 
Note: See TracChangeset for help on using the changeset viewer.