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.
make_dmp_file.F90 in branches/UKMO/dev_r5518_DMP_TOOLS/NEMOGCM/TOOLS/DMP_TOOLS/src – NEMO

source: branches/UKMO/dev_r5518_DMP_TOOLS/NEMOGCM/TOOLS/DMP_TOOLS/src/make_dmp_file.F90

Last change on this file was 10722, checked in by jenniewaters, 5 years ago

Changes to make sure original functionality works correctly.

File size: 4.6 KB
Line 
1PROGRAM make_dmp_file
2  !================================================================================
3  !               *** PROGRAM make_dmp_file ****
4  !================================================================================
5  !
6  !  Purpose: Create a file containing a spacially varying
7  !           restoration coefficient to be used by TRADMP
8  !
9  !  Method:  1) Read in tmask from mesh_mask file to use as a template
10  !           2) Calculate restoration coefficients according to options
11  !           specified in the namelist. The user may modify custom.F90 to
12  !           specify specific damping options e.g. to mask certain regions only).
13  !           3) Write the array to output file
14  !
15  !  History: Original code: Tim Graham (Jul 2014) - some code moved from
16  !                            old tradmp.F90 module to this tool (as part of NEMO
17  !                            simplification process).
18  !-------------------------------------------------------------------------------
19
20  ! Declare variables
21  USE netcdf 
22  USE utils
23  USE coastdist
24  USE med_red_seas
25  USE zoom
26  USE custom
27
28  IMPLICIT NONE
29  INTEGER  :: ji, jj, jk                         ! dummpy loop variables
30  REAL(wp) :: zsdmp, zbdmp                     ! Surface and bottom damping coeff
31  CHARACTER(LEN=200) :: meshfile = 'mesh_mask.nc'   ! mesh file
32  CHARACTER(LEN=200) :: outfile = 'resto.nc'     ! output file
33  REAL(wp) :: zlat, zlat2, zlat0
34  LOGICAL  :: ln_distcoast_calc                  ! logical for calculating the distance
35                                                 ! to coast on the first depth.
36  REAL(wp), DIMENSION(:,:),   ALLOCATABLE :: zdct! distance to coast field
37
38  ! Read namelist
39  OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' )
40  READ( numnam, nam_dmp_create )
41  CLOSE( numnam )
42 
43  IF ( ln_full_field .AND. lzoom ) THEN
44    WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.'
45    STOP
46  ENDIF
47
48  CALL grid_info(meshfile)
49  WRITE(numout, *) 'jpi = ',jpi
50  WRITE(numout, *) 'jpj = ',jpj
51  WRITE(numout, *) 'jpk = ',jpk
52
53  ln_distcoast_calc=.true.
54
55  ALLOCATE( resto(jpi, jpj) )
56  ALLOCATE( zdct(jpi, jpj) )
57
58  !Create output file
59  CALL make_outfile( outfile )
60 
61  CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) )
62
63  !Calculate surface and bottom damping coefficients
64  zsdmp = 1._wp / ( pn_surf * rday )
65  zbdmp = 1._wp / ( pn_bot  * rday )
66
67  !Loop through levels and read in tmask for each level as starting point for
68  !coefficient array
69  DO jk = 1, jpk-1
70     resto(:,:) = 0._wp
71     
72     IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN 
73        !Read in tmask depth for this level
74        CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
75        CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
76     
77
78        IF ( ln_full_field ) THEN
79           !Set basic value of resto
80           DO jj = 1, jpj
81              DO ji = 1, jpi
82                 resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep))
83              END DO
84           END DO
85           IF ((nn_hdmp > 0)) THEN
86              zlat0 = 10. !width of latitude strip where resto decreases
87              zlat2 = nn_hdmp + zlat0
88              DO jj = 1, jpj
89                 DO ji = 1, jpi
90                    zlat = ABS(gphit(ji,jj))
91                    IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN
92                       resto(ji,jj) = resto(ji,jj) * 0.5_wp * (  1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) )
93                    ELSE IF ( zlat < nn_hdmp ) THEN
94                       resto(ji,jj) = 0._wp
95                    ENDIF
96                 END DO
97              END DO
98           ENDIF
99   
100           IF (ln_coast) THEN
101              ! Reduce damping in vicinity of coastlines
102              CALL coast_dist_weight(resto, zdct, ln_readdistcoast, jk, ln_distcoast_calc)
103           ENDIF
104        ENDIF
105
106        ! Damping in Med/Red Seas (or local modifications if full field is set)
107        IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN
108           CALL med_red_dmp(resto, jk, ln_old_31_lev_code)
109        ENDIF
110
111        IF ( lzoom ) THEN
112              CALL dtacof_zoom(resto, tmask)
113        ENDIF
114       
115        !Any user modifications can be added in the custom module
116        IF ( ln_custom ) THEN
117              CALL custom_resto( resto )
118        ENDIF
119     ENDIF
120
121     ! Write out resto for this level
122     CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) )
123
124  END DO
125 
126  ! Close the output file
127  CALL check_nf90( nf90_close(ncout) )
128
129END PROGRAM make_dmp_file
Note: See TracBrowser for help on using the repository browser.