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.
agrif_recompute_scalefactors.f90 in NEMO/branches/2019/ENHANCE-03_domcfg/src – NEMO

source: NEMO/branches/2019/ENHANCE-03_domcfg/src/agrif_recompute_scalefactors.f90 @ 11602

Last change on this file since 11602 was 10727, checked in by rblod, 5 years ago

new nesting tools (attempt) and brutal cleaning of DOMAINcfg, see ticket #2129

File size: 4.2 KB
Line 
1#if defined key_agrif
2subroutine agrif_recompute_scalefactors
3   USE dom_oce
4   USE lbclnk            ! ocean lateral boundary conditions (or mpp link)
5   USE lib_mpp
6implicit none
7INTEGER :: ji,jj,jk,ikb,ikt
8
9      ! Scale factors and depth at U-, V-, UW and VW-points
10      DO jk = 1, jpk                        ! initialisation to z-scale factors
11!         e3u_0 (:,:,jk) = e3t_1d(jk)
12!         e3v_0 (:,:,jk) = e3t_1d(jk)
13         e3uw_0(:,:,jk) = e3w_1d(jk)
14         e3vw_0(:,:,jk) = e3w_1d(jk)
15      END DO
16
17      DO jk = 1,jpk                         ! Computed as the minimum of neighbooring scale factors
18         DO jj = 1, jpjm1
19            DO ji = 1, jpim1   ! vector opt.
20!               e3u_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji+1,jj,jk) )
21!               e3v_0 (ji,jj,jk) = MIN( e3t_0(ji,jj,jk), e3t_0(ji,jj+1,jk) )
22               e3uw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji+1,jj,jk) )
23               e3vw_0(ji,jj,jk) = MIN( e3w_0(ji,jj,jk), e3w_0(ji,jj+1,jk) )
24            END DO
25         END DO
26      END DO
27      IF ( ln_isfcav ) THEN
28      ! (ISF) define e3uw (adapted for 2 cells in the water column)
29         DO jj = 2, jpjm1 
30            DO ji = 2, jpim1   ! vector opt.
31               ikb = MAX(mbathy (ji,jj),mbathy (ji+1,jj))
32               ikt = MAX(misfdep(ji,jj),misfdep(ji+1,jj))
33               IF (ikb == ikt+1) e3uw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji+1,jj  ,ikb  ) ) &
34                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji+1,jj  ,ikb-1) )
35               ikb = MAX(mbathy (ji,jj),mbathy (ji,jj+1))
36               ikt = MAX(misfdep(ji,jj),misfdep(ji,jj+1))
37               IF (ikb == ikt+1) e3vw_0(ji,jj,ikb) =  MIN( gdept_0(ji,jj,ikb  ), gdept_0(ji  ,jj+1,ikb  ) ) &
38                                       &            - MAX( gdept_0(ji,jj,ikb-1), gdept_0(ji  ,jj+1,ikb-1) )
39            END DO
40         END DO
41      END IF
42
43      CALL lbc_lnk('toto', e3u_0 , 'U', 1._wp )   ;   CALL lbc_lnk('toto', e3uw_0, 'U', 1._wp )   ! lateral boundary conditions
44      CALL lbc_lnk( 'toto',e3v_0 , 'V', 1._wp )   ;   CALL lbc_lnk('toto', e3vw_0, 'V', 1._wp )
45      !
46
47      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
48         WHERE( e3u_0 (:,:,jk) == 0._wp )   e3u_0 (:,:,jk) = e3t_1d(jk)
49         WHERE( e3v_0 (:,:,jk) == 0._wp )   e3v_0 (:,:,jk) = e3t_1d(jk)
50         WHERE( e3uw_0(:,:,jk) == 0._wp )   e3uw_0(:,:,jk) = e3w_1d(jk)
51         WHERE( e3vw_0(:,:,jk) == 0._wp )   e3vw_0(:,:,jk) = e3w_1d(jk)
52      END DO
53     
54      ! Scale factor at F-point
55      DO jk = 1, jpk                        ! initialisation to z-scale factors
56         e3f_0(:,:,jk) = e3t_1d(jk)
57      END DO
58      DO jk = 1, jpk                        ! Computed as the minimum of neighbooring V-scale factors
59         DO jj = 1, jpjm1
60            DO ji = 1, jpim1   ! vector opt.
61               e3f_0(ji,jj,jk) = MIN( e3v_0(ji,jj,jk), e3v_0(ji+1,jj,jk) )
62            END DO
63         END DO
64      END DO
65      CALL lbc_lnk('toto', e3f_0, 'F', 1._wp )       ! Lateral boundary conditions
66      !
67      DO jk = 1, jpk                        ! set to z-scale factor if zero (i.e. along closed boundaries)
68         WHERE( e3f_0(:,:,jk) == 0._wp )   e3f_0(:,:,jk) = e3t_1d(jk)
69      END DO
70!!gm  bug ? :  must be a do loop with mj0,mj1
71      !
72      e3t_0(:,mj0(1),:) = e3t_0(:,mj0(2),:)     ! we duplicate factor scales for jj = 1 and jj = 2
73      e3w_0(:,mj0(1),:) = e3w_0(:,mj0(2),:) 
74      e3u_0(:,mj0(1),:) = e3u_0(:,mj0(2),:) 
75      e3v_0(:,mj0(1),:) = e3v_0(:,mj0(2),:) 
76      e3f_0(:,mj0(1),:) = e3f_0(:,mj0(2),:) 
77
78      ! Control of the sign
79      IF( MINVAL( e3t_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3t_0 <= 0' )
80      IF( MINVAL( e3w_0  (:,:,:) ) <= 0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   e3w_0 <= 0' )
81      IF( MINVAL( gdept_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdept_0 <  0' )
82      IF( MINVAL( gdepw_0(:,:,:) ) <  0._wp )   CALL ctl_stop( '    zgr_zps :   e r r o r   gdepw_0 <  0' )
83     
84end subroutine agrif_recompute_scalefactors
85#else
86subroutine agrif_recompute_scalefactors_empty
87end subroutine agrif_recompute_scalefactors_empty
88#endif
Note: See TracBrowser for help on using the repository browser.