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.
zoom.F90 in branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src – NEMO

source: branches/2014/dev_r4650_UKMO3_masked_damping/NEMOGCM/TOOLS/DMP_TOOLS/src/zoom.F90 @ 4738

Last change on this file since 4738 was 4738, checked in by timgraham, 10 years ago

Modified tra_dmp module to read in restoration coefficient from a netcdf file

Added a tool to create the netcdf file - this replaces all of the hard coded resolution dependencies in tra_dmp_init

File size: 3.5 KB
Line 
1MODULE zoom
2   
3   USE utils
4
5   CONTAINS
6
7   SUBROUTINE dtacof_zoom( presto, mask)
8      !!----------------------------------------------------------------------
9      !!                  ***  ROUTINE dtacof_zoom  ***
10      !!
11      !! ** Purpose :   Compute the damping coefficient for zoom domain
12      !!
13      !! ** Method  : - set along closed boundary due to zoom a damping over
14      !!                6 points with a max time scale of 5 days.
15      !!              - ORCA arctic/antarctic zoom: set the damping along
16      !!                south/north boundary over a latitude strip.
17      !!
18      !! ** Action  : - resto, the damping coeff. for T and S
19      !!----------------------------------------------------------------------
20      REAL(8), DIMENSION(jpi,jpj), INTENT(inout)  ::   presto   ! restoring coeff. (s-1)
21      REAL(8), DIMENSION(jpi,jpj), INTENT(in)  ::   mask   ! restoring coeff. (s-1)
22      !
23      INTEGER  ::   ji, jj, jn   ! dummy loop indices
24      REAL(8) ::   zlat, zlat0, zlat1, zlat2, z1_5d   ! local scalar
25      REAL(8), DIMENSION(6)  ::   zfact               ! 1Dworkspace
26      !!----------------------------------------------------------------------
27      !
28      IF( nn_timing == 1 )  CALL timing_start( 'dtacof_zoom')
29      !
30     
31
32      zfact(1) =  1.
33      zfact(2) =  1.
34      zfact(3) = 11. / 12.
35      zfact(4) =  8. / 12.
36      zfact(5) =  4. / 12.
37      zfact(6) =  1. / 12.
38      zfact(:) = zfact(:) / ( 5. * rday )    ! 5 days max restoring time scale
39
40      presto(:,:) = 0.
41
42      ! damping along the forced closed boundary over 6 grid-points
43      DO jn = 1, 6
44         IF( lzoom_w )   presto( jn, : )                    = zfact(jn)   ! west  closed
45         IF( lzoom_s )   presto( : , jn )                    = zfact(jn)   ! south closed
46         IF( lzoom_e )   presto( jpi+1-jn , : ) = zfact(jn)   ! east  closed
47         IF( lzoom_n )   presto( : , jpj+1-jn ) = zfact(jn)   ! north closed
48      END DO
49
50      !                                           ! ====================================================
51      IF( cp_cfz == "arctic" .OR. cp_cfz == "antarctic" ) THEN   !  ORCA configuration : arctic or antarctic zoom
52         !                                        ! ====================================================
53         IF(lwp) WRITE(numout,*)
54         IF(lwp .AND. cp_cfz == "arctic" ) WRITE(numout,*) '              dtacof_zoom : ORCA    Arctic zoom'
55         IF(lwp .AND. cp_cfz == "antarctic" ) WRITE(numout,*) '           dtacof_zoom : ORCA Antarctic zoom'
56         IF(lwp) WRITE(numout,*)
57         !
58         !                          ! Initialization :
59         presto(:,:) = 0.
60         zlat0 = 10.                     ! zlat0 : latitude strip where resto decreases
61         zlat1 = 30.                     ! zlat1 : resto = 1 before zlat1
62         zlat2 = zlat1 + zlat0              ! zlat2 : resto decreases from 1 to 0 between zlat1 and zlat2
63         z1_5d = 1. / ( 5. * rday )   ! z1_5d : 1 / 5days
64
65         DO jj = 1, jpj
66            DO ji = 1, jpi
67               zlat = ABS( gphit(ji,jj) )
68               IF( zlat1 <= zlat .AND. zlat <= zlat2 ) THEN
69                  presto(ji,jj) = 0.5 * z1_5d * (  1. - COS( rpi*(zlat2-zlat)/zlat0 )  ) 
70               ELSEIF( zlat < zlat1 ) THEN
71                  presto(ji,jj) = z1_5d
72               ENDIF
73            END DO
74         END DO
75         !
76      ENDIF
77      !                             ! Mask resto array
78      presto(:,:) = presto(:,:) * mask(:,:)
79
80   END SUBROUTINE dtacof_zoom
81
82END MODULE zoom
Note: See TracBrowser for help on using the repository browser.