1 | PROGRAM 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 | |
---|
35 | ! Read namelist |
---|
36 | OPEN( UNIT=numnam, FILE='namelist', FORM='FORMATTED', STATUS='OLD' ) |
---|
37 | READ( numnam, nam_dmp_create ) |
---|
38 | CLOSE( numnam ) |
---|
39 | |
---|
40 | IF ( ln_full_field .AND. lzoom ) THEN |
---|
41 | WRITE(numerr,*) 'Only one of ln_full_field and lzoom can be .true.' |
---|
42 | STOP |
---|
43 | ENDIF |
---|
44 | |
---|
45 | CALL grid_info(meshfile) |
---|
46 | WRITE(numout, *) 'jpi = ',jpi |
---|
47 | WRITE(numout, *) 'jpj = ',jpj |
---|
48 | WRITE(numout, *) 'jpk = ',jpk |
---|
49 | |
---|
50 | ALLOCATE( resto(jpi, jpj) ) |
---|
51 | |
---|
52 | !Create output file |
---|
53 | CALL make_outfile( outfile ) |
---|
54 | |
---|
55 | CALL check_nf90( nf90_get_var( ncin, gphit_id, gphit, (/ 1,1 /), (/ jpi, jpj /) ) ) |
---|
56 | |
---|
57 | !Calculate surface and bottom damping coefficients |
---|
58 | zsdmp = 1._wp / ( pn_surf * rday ) |
---|
59 | zbdmp = 1._wp / ( pn_bot * rday ) |
---|
60 | |
---|
61 | !Loop through levels and read in tmask for each level as starting point for |
---|
62 | !coefficient array |
---|
63 | DO jk = 1, jpk-1 |
---|
64 | resto(:,:) = 0._wp |
---|
65 | |
---|
66 | IF (.NOT. (jk == 1 .AND. ln_zero_top_layer) ) THEN |
---|
67 | !Read in tmask depth for this level |
---|
68 | CALL check_nf90( nf90_get_var( ncin, tmask_id, tmask, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
69 | CALL check_nf90( nf90_get_var( ncin, gdept_id, gdept, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
70 | |
---|
71 | |
---|
72 | IF ( ln_full_field ) THEN |
---|
73 | !Set basic value of resto |
---|
74 | DO jj = 1, jpj |
---|
75 | DO ji = 1, jpi |
---|
76 | resto(ji,jj) = tmask(ji, jj) * (zbdmp + (zsdmp-zbdmp) * EXP(-gdept(ji,jj)/pn_dep)) |
---|
77 | END DO |
---|
78 | END DO |
---|
79 | IF ((nn_hdmp > 0)) THEN |
---|
80 | zlat0 = 10. !width of latitude strip where resto decreases |
---|
81 | zlat2 = nn_hdmp + zlat0 |
---|
82 | DO jj = 1, jpj |
---|
83 | DO ji = 1, jpi |
---|
84 | zlat = ABS(gphit(ji,jj)) |
---|
85 | IF ( nn_hdmp <= zlat .AND. zlat <= zlat2 ) THEN |
---|
86 | resto(ji,jj) = resto(ji,jj) * 0.5_wp * ( 1._wp - COS( rpi*(zlat-nn_hdmp)/zlat0 ) ) |
---|
87 | ELSE IF ( zlat < nn_hdmp ) THEN |
---|
88 | resto(ji,jj) = 0._wp |
---|
89 | ENDIF |
---|
90 | END DO |
---|
91 | END DO |
---|
92 | ENDIF |
---|
93 | |
---|
94 | IF (ln_coast) THEN |
---|
95 | ! Reduce damping in vicinity of coastlines |
---|
96 | CALL coast_dist_weight(resto) |
---|
97 | ENDIF |
---|
98 | ENDIF |
---|
99 | |
---|
100 | ! Damping in Med/Red Seas (or local modifications if full field is set) |
---|
101 | IF (ln_med_red_seas .AND. (cp_cfg == 'orca') .AND. (.NOT. lzoom)) THEN |
---|
102 | CALL med_red_dmp(resto, jk, ln_old_31_lev_code) |
---|
103 | ENDIF |
---|
104 | |
---|
105 | IF ( lzoom ) THEN |
---|
106 | CALL dtacof_zoom(resto, tmask) |
---|
107 | ENDIF |
---|
108 | |
---|
109 | !Any user modifications can be added in the custom module |
---|
110 | IF ( ln_custom ) THEN |
---|
111 | CALL custom_resto( resto ) |
---|
112 | ENDIF |
---|
113 | ENDIF |
---|
114 | |
---|
115 | ! Write out resto for this level |
---|
116 | CALL check_nf90( nf90_put_var( ncout, resto_id, resto, (/ 1,1,jk /), (/ jpi, jpj,1 /) ) ) |
---|
117 | |
---|
118 | END DO |
---|
119 | |
---|
120 | ! Close the output file |
---|
121 | CALL check_nf90( nf90_close(ncout) ) |
---|
122 | |
---|
123 | END PROGRAM make_dmp_file |
---|