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 13982 for NEMO/trunk/src/OCE/ASM/asminc.F90 – NEMO

Ignore:
Timestamp:
2020-12-02T11:57:05+01:00 (3 years ago)
Author:
smasson
Message:

trunk: merge dev_r13923_Tiling_Cleanup_MPI3_LoopFusion into the trunk

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/ASM/asminc.F90

    r13295 r13982  
    2626   USE par_oce         ! Ocean space and time domain variables 
    2727   USE dom_oce         ! Ocean space and time domain 
     28   USE domain, ONLY : dom_tile 
    2829   USE domvvl          ! domain: variable volume level 
    2930   USE ldfdyn          ! lateral diffusion: eddy viscosity coefficients 
     
    518519      ! 
    519520      INTEGER  :: ji, jj, jk 
    520       INTEGER  :: it 
     521      INTEGER  :: it, itile 
    521522      REAL(wp) :: zincwgt  ! IAU weight for current time step 
    522       REAL (wp), DIMENSION(jpi,jpj,jpk) :: fzptnz ! 3d freezing point values 
     523      REAL(wp), DIMENSION(A2D(nn_hls),jpk) :: fzptnz ! 3d freezing point values 
    523524      !!---------------------------------------------------------------------- 
    524525      ! 
    525526      ! freezing point calculation taken from oc_fz_pt (but calculated for all depths)  
    526527      ! used to prevent the applied increments taking the temperature below the local freezing point  
    527       DO jk = 1, jpkm1 
    528         CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
    529       END DO 
     528      IF( ln_temnofreeze ) THEN 
     529         DO jk = 1, jpkm1 
     530           CALL eos_fzp( pts(:,:,jk,jp_sal,Kmm), fzptnz(:,:,jk), gdept(:,:,jk,Kmm) ) 
     531         END DO 
     532      ENDIF 
    530533         ! 
    531534         !                             !-------------------------------------- 
     
    538541            zincwgt = wgtiau(it) / rn_Dt   ! IAU weight for the current time step 
    539542            ! 
    540             IF(lwp) THEN 
    541                WRITE(numout,*)  
    542                WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    543                WRITE(numout,*) '~~~~~~~~~~~~' 
     543            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     544               IF(lwp) THEN 
     545                  WRITE(numout,*) 
     546                  WRITE(numout,*) 'tra_asm_inc : Tracer IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
     547                  WRITE(numout,*) '~~~~~~~~~~~~' 
     548               ENDIF 
    544549            ENDIF 
    545550            ! 
     
    548553               IF (ln_temnofreeze) THEN 
    549554                  ! Do not apply negative increments if the temperature will fall below freezing 
    550                   WHERE(t_bkginc(:,:,jk) > 0.0_wp .OR. & 
    551                      &   pts(:,:,jk,jp_tem,Kmm) + pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * wgtiau(it) > fzptnz(:,:,jk) )  
    552                      pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     555                  WHERE(t_bkginc(A2D(0),jk) > 0.0_wp .OR. & 
     556                     &   pts(A2D(0),jk,jp_tem,Kmm) + pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * wgtiau(it) > fzptnz(:,:,jk) ) 
     557                     pts(A2D(0),jk,jp_tem,Krhs) = pts(A2D(0),jk,jp_tem,Krhs) + t_bkginc(A2D(0),jk) * zincwgt 
    553558                  END WHERE 
    554559               ELSE 
    555                   pts(:,:,jk,jp_tem,Krhs) = pts(:,:,jk,jp_tem,Krhs) + t_bkginc(:,:,jk) * zincwgt   
     560                  DO_2D( 0, 0, 0, 0 ) 
     561                     pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) + t_bkginc(ji,jj,jk) * zincwgt 
     562                  END_2D 
    556563               ENDIF 
    557564               IF (ln_salfix) THEN 
    558565                  ! Do not apply negative increments if the salinity will fall below a specified 
    559566                  ! minimum value salfixmin 
    560                   WHERE(s_bkginc(:,:,jk) > 0.0_wp .OR. & 
    561                      &   pts(:,:,jk,jp_sal,Kmm) + pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * wgtiau(it) > salfixmin )  
    562                      pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 
     567                  WHERE(s_bkginc(A2D(0),jk) > 0.0_wp .OR. & 
     568                     &   pts(A2D(0),jk,jp_sal,Kmm) + pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * wgtiau(it) > salfixmin ) 
     569                     pts(A2D(0),jk,jp_sal,Krhs) = pts(A2D(0),jk,jp_sal,Krhs) + s_bkginc(A2D(0),jk) * zincwgt 
    563570                  END WHERE 
    564571               ELSE 
    565                   pts(:,:,jk,jp_sal,Krhs) = pts(:,:,jk,jp_sal,Krhs) + s_bkginc(:,:,jk) * zincwgt 
     572                  DO_2D( 0, 0, 0, 0 ) 
     573                     pts(ji,jj,jk,jp_sal,Krhs) = pts(ji,jj,jk,jp_sal,Krhs) + s_bkginc(ji,jj,jk) * zincwgt 
     574                  END_2D 
    566575               ENDIF 
    567576            END DO 
     
    569578         ENDIF 
    570579         ! 
    571          IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
    572             DEALLOCATE( t_bkginc ) 
    573             DEALLOCATE( s_bkginc ) 
     580         IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     581            IF ( kt == nitiaufin_r + 1  ) THEN   ! For bias crcn to work 
     582               DEALLOCATE( t_bkginc ) 
     583               DEALLOCATE( s_bkginc ) 
     584            ENDIF 
    574585         ENDIF 
    575586         !                             !-------------------------------------- 
     
    584595            IF (ln_temnofreeze) THEN 
    585596               ! Do not apply negative increments if the temperature will fall below freezing 
    586                WHERE( t_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_tem,Kmm) + t_bkginc(:,:,:) > fzptnz(:,:,:) )  
    587                   pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     597               WHERE( t_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_tem,Kmm) + t_bkginc(A2D(0),:) > fzptnz(:,:,:) ) 
     598                  pts(A2D(0),:,jp_tem,Kmm) = t_bkg(A2D(0),:) + t_bkginc(A2D(0),:) 
    588599               END WHERE 
    589600            ELSE 
    590                pts(:,:,:,jp_tem,Kmm) = t_bkg(:,:,:) + t_bkginc(:,:,:)    
     601               DO_3D( 0, 0, 0, 0, 1, jpk ) 
     602                  pts(ji,jj,jk,jp_tem,Kmm) = t_bkg(ji,jj,jk) + t_bkginc(ji,jj,jk) 
     603               END_3D 
    591604            ENDIF 
    592605            IF (ln_salfix) THEN 
    593606               ! Do not apply negative increments if the salinity will fall below a specified 
    594607               ! minimum value salfixmin 
    595                WHERE( s_bkginc(:,:,:) > 0.0_wp .OR. pts(:,:,:,jp_sal,Kmm) + s_bkginc(:,:,:) > salfixmin )  
    596                   pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
     608               WHERE( s_bkginc(A2D(0),:) > 0.0_wp .OR. pts(A2D(0),:,jp_sal,Kmm) + s_bkginc(A2D(0),:) > salfixmin ) 
     609                  pts(A2D(0),:,jp_sal,Kmm) = s_bkg(A2D(0),:) + s_bkginc(A2D(0),:) 
    597610               END WHERE 
    598611            ELSE 
    599                pts(:,:,:,jp_sal,Kmm) = s_bkg(:,:,:) + s_bkginc(:,:,:)    
    600             ENDIF 
    601  
    602             pts(:,:,:,:,Kbb) = pts(:,:,:,:,Kmm)                 ! Update before fields 
     612               DO_3D( 0, 0, 0, 0, 1, jpk ) 
     613                  pts(ji,jj,jk,jp_sal,Kmm) = s_bkg(ji,jj,jk) + s_bkginc(ji,jj,jk) 
     614               END_3D 
     615            ENDIF 
     616 
     617            DO_3D( 0, 0, 0, 0, 1, jpk ) 
     618               pts(ji,jj,jk,:,Kbb) = pts(ji,jj,jk,:,Kmm)             ! Update before fields 
     619            END_3D 
    603620 
    604621            CALL eos( pts(:,:,:,:,Kbb), rhd, rhop, gdept_0(:,:,:) )  ! Before potential and in situ densities 
     
    607624!!gm 
    608625 
    609             IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
    610                &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
    611                &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
    612             IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
    613                &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
    614                &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
    615  
    616             DEALLOCATE( t_bkginc ) 
    617             DEALLOCATE( s_bkginc ) 
    618             DEALLOCATE( t_bkg    ) 
    619             DEALLOCATE( s_bkg    ) 
     626            ! TEMP: [tiling] This change not necessary after extra haloes development (lbc_lnk removed from zps_hde*) 
     627            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only for the full domain 
     628               itile = ntile 
     629               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 )            ! Use full domain 
     630 
     631               IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav)           & 
     632                  &  CALL zps_hde    ( kt, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv,        &  ! Partial steps: before horizontal gradient 
     633                  &                              rhd, gru , grv               )  ! of t, s, rd at the last ocean level 
     634               IF( ln_zps .AND. .NOT. lk_c1d .AND.       ln_isfcav)                       & 
     635                  &  CALL zps_hde_isf( nit000, Kmm, jpts, pts(:,:,:,:,Kbb), gtsu, gtsv, gtui, gtvi,    &  ! Partial steps for top cell (ISF) 
     636                  &                                  rhd, gru , grv , grui, grvi          )  ! of t, s, rd at the last ocean level 
     637 
     638               IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile )            ! Revert to tile domain 
     639            ENDIF 
     640 
     641            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     642               DEALLOCATE( t_bkginc ) 
     643               DEALLOCATE( s_bkginc ) 
     644               DEALLOCATE( t_bkg    ) 
     645               DEALLOCATE( s_bkg    ) 
     646            ENDIF 
     647         ! 
    620648         ENDIF 
    621649         !   
     
    829857      INTEGER, INTENT(in), OPTIONAL ::   kindic   ! flag for disabling the deallocation 
    830858      ! 
     859      INTEGER  ::   ji, jj 
    831860      INTEGER  ::   it 
    832861      REAL(wp) ::   zincwgt   ! IAU weight for current time step 
    833862#if defined key_si3 
    834       REAL(wp), DIMENSION(jpi,jpj) ::   zofrld, zohicif, zseaicendg, zhicifinc 
     863      REAL(wp), DIMENSION(A2D(nn_hls)) ::   zofrld, zohicif, zseaicendg, zhicifinc 
    835864      REAL(wp) ::   zhicifmin = 0.5_wp      ! ice minimum depth in metres 
    836865#endif 
     
    847876            ! note this is not a tendency so should not be divided by rn_Dt (as with the tracer and other increments) 
    848877            ! 
    849             IF(lwp) THEN 
    850                WRITE(numout,*)  
    851                WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
    852                WRITE(numout,*) '~~~~~~~~~~~~' 
     878            IF( ntile == 0 .OR. ntile == 1 )  THEN                       ! Do only on the first tile 
     879               IF(lwp) THEN 
     880                  WRITE(numout,*) 
     881                  WRITE(numout,*) 'seaice_asm_inc : sea ice conc IAU at time step = ', kt,' with IAU weight = ', wgtiau(it) 
     882                  WRITE(numout,*) '~~~~~~~~~~~~' 
     883               ENDIF 
    853884            ENDIF 
    854885            ! 
     
    856887            ! 
    857888#if defined key_si3 
    858             zofrld (:,:) = 1._wp - at_i(:,:) 
    859             zohicif(:,:) = hm_i(:,:) 
    860             ! 
    861             at_i  (:,:) = 1. - MIN( MAX( 1.-at_i  (:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    862             at_i_b(:,:) = 1. - MIN( MAX( 1.-at_i_b(:,:) - seaice_bkginc(:,:) * zincwgt, 0.0_wp), 1.0_wp) 
    863             fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
    864             ! 
    865             zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
     889            DO_2D( 0, 0, 0, 0 ) 
     890               zofrld (ji,jj) = 1._wp - at_i(ji,jj) 
     891               zohicif(ji,jj) = hm_i(ji,jj) 
     892               ! 
     893               at_i  (ji,jj) = 1. - MIN( MAX( 1.-at_i  (ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 
     894               at_i_b(ji,jj) = 1. - MIN( MAX( 1.-at_i_b(ji,jj) - seaice_bkginc(ji,jj) * zincwgt, 0.0_wp), 1.0_wp) 
     895               fr_i(ji,jj) = at_i(ji,jj)        ! adjust ice fraction 
     896               ! 
     897               zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj))   ! find out actual sea ice nudge applied 
     898            END_2D 
    866899            ! 
    867900            ! Nudge sea ice depth to bring it up to a required minimum depth 
    868             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
    869                zhicifinc(:,:) = (zhicifmin - hm_i(:,:)) * zincwgt     
     901            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 
     902               zhicifinc(:,:) = (zhicifmin - hm_i(A2D(0))) * zincwgt 
    870903            ELSEWHERE 
    871904               zhicifinc(:,:) = 0.0_wp 
     
    873906            ! 
    874907            ! nudge ice depth 
    875             hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
     908            DO_2D( 0, 0, 0, 0 ) 
     909               hm_i (ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 
     910            END_2D 
    876911            ! 
    877912            ! seaice salinity balancing (to add) 
     
    880915#if defined key_cice && defined key_asminc 
    881916            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    882             ndaice_da(:,:) = seaice_bkginc(:,:) * zincwgt / rn_Dt 
    883 #endif 
    884             ! 
    885             IF ( kt == nitiaufin_r ) THEN 
    886                DEALLOCATE( seaice_bkginc ) 
     917            DO_2D( 0, 0, 0, 0 ) 
     918               ndaice_da(ji,jj) = seaice_bkginc(ji,jj) * zincwgt / rn_Dt 
     919            END_2D 
     920#endif 
     921            ! 
     922            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     923               IF ( kt == nitiaufin_r ) THEN 
     924                  DEALLOCATE( seaice_bkginc ) 
     925               ENDIF 
    887926            ENDIF 
    888927            ! 
     
    890929            ! 
    891930#if defined key_cice && defined key_asminc 
    892             ndaice_da(:,:) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     931            DO_2D( 0, 0, 0, 0 ) 
     932               ndaice_da(ji,jj) = 0._wp        ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     933            END_2D 
    893934#endif 
    894935            ! 
     
    905946            ! 
    906947#if defined key_si3 
    907             zofrld (:,:) = 1._wp - at_i(:,:) 
    908             zohicif(:,:) = hm_i(:,:) 
    909             !  
    910             ! Initialize the now fields the background + increment 
    911             at_i(:,:) = 1. - MIN( MAX( 1.-at_i(:,:) - seaice_bkginc(:,:), 0.0_wp), 1.0_wp) 
    912             at_i_b(:,:) = at_i(:,:)  
    913             fr_i(:,:) = at_i(:,:)        ! adjust ice fraction 
    914             ! 
    915             zseaicendg(:,:) = zofrld(:,:) - (1. - at_i(:,:))   ! find out actual sea ice nudge applied 
     948            DO_2D( 0, 0, 0, 0 ) 
     949               zofrld (ji,jj) = 1._wp - at_i(ji,jj) 
     950               zohicif(ji,jj) = hm_i(ji,jj) 
     951               ! 
     952               ! Initialize the now fields the background + increment 
     953               at_i(ji,jj) = 1. - MIN( MAX( 1.-at_i(ji,jj) - seaice_bkginc(ji,jj), 0.0_wp), 1.0_wp) 
     954               at_i_b(ji,jj) = at_i(ji,jj) 
     955               fr_i(ji,jj) = at_i(ji,jj)        ! adjust ice fraction 
     956               ! 
     957               zseaicendg(ji,jj) = zofrld(ji,jj) - (1. - at_i(ji,jj))   ! find out actual sea ice nudge applied 
     958            END_2D 
    916959            ! 
    917960            ! Nudge sea ice depth to bring it up to a required minimum depth 
    918             WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(:,:) < zhicifmin )  
    919                zhicifinc(:,:) = zhicifmin - hm_i(:,:) 
     961            WHERE( zseaicendg(:,:) > 0.0_wp .AND. hm_i(A2D(0)) < zhicifmin ) 
     962               zhicifinc(:,:) = zhicifmin - hm_i(A2D(0)) 
    920963            ELSEWHERE 
    921964               zhicifinc(:,:) = 0.0_wp 
     
    923966            ! 
    924967            ! nudge ice depth 
    925             hm_i (:,:) = hm_i (:,:) + zhicifinc(:,:) 
     968            DO_2D( 0, 0, 0, 0 ) 
     969               hm_i(ji,jj) = hm_i (ji,jj) + zhicifinc(ji,jj) 
     970            END_2D 
    926971            ! 
    927972            ! seaice salinity balancing (to add) 
     
    930975#if defined key_cice && defined key_asminc 
    931976            ! Sea-ice : CICE case. Pass ice increment tendency into CICE 
    932            ndaice_da(:,:) = seaice_bkginc(:,:) / rn_Dt 
    933 #endif 
    934             IF ( .NOT. PRESENT(kindic) ) THEN 
    935                DEALLOCATE( seaice_bkginc ) 
    936             END IF 
     977            DO_2D( 0, 0, 0, 0 ) 
     978               ndaice_da(ji,jj) = seaice_bkginc(ji,jj) / rn_Dt 
     979            END_2D 
     980#endif 
     981            IF( ntile == 0 .OR. ntile == nijtile )  THEN                ! Do only on the last tile 
     982               IF ( .NOT. PRESENT(kindic) ) THEN 
     983                  DEALLOCATE( seaice_bkginc ) 
     984               END IF 
     985            ENDIF 
    937986            ! 
    938987         ELSE 
    939988            ! 
    940989#if defined key_cice && defined key_asminc 
    941             ndaice_da(:,:) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     990            DO_2D( 0, 0, 0, 0 ) 
     991               ndaice_da(ji,jj) = 0._wp     ! Sea-ice : CICE case. Zero ice increment tendency into CICE 
     992            END_2D 
    942993#endif 
    943994            ! 
Note: See TracChangeset for help on using the changeset viewer.