- Timestamp:
- 2011-02-27T13:45:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2590 r2623 32 32 PUBLIC tra_adv ! routine called by step module 33 33 PUBLIC tra_adv_init ! routine called by opa module 34 PUBLIC tra_adv_alloc ! routine called by nemogcm module35 34 36 35 ! !!* Namelist namtra_adv * … … 44 43 INTEGER :: nadv ! choice of the type of advection scheme 45 44 46 REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: r2dt ! vertical profile time-step, = 2 rdttra except at nit000 (=rdttra) if neuler=047 48 45 !! * Substitutions 49 46 # include "domzgr_substitute.h90" … … 55 52 !!---------------------------------------------------------------------- 56 53 CONTAINS 57 58 FUNCTION tra_adv_alloc()59 !!----------------------------------------------------------------------60 !! *** ROUTINE tra_adv_alloc ***61 !!----------------------------------------------------------------------62 IMPLICIT none63 INTEGER tra_adv_alloc64 !!----------------------------------------------------------------------65 66 ALLOCATE( r2dt(jpk), Stat=tra_adv_alloc)67 68 IF(tra_adv_alloc /= 0)THEN69 CALL ctl_warn('tra_adv_alloc: failed to allocate array.')70 END IF71 72 END FUNCTION tra_adv_alloc73 54 74 55 SUBROUTINE tra_adv( kt ) … … 80 61 !! ** Method : - Update (ua,va) with the advection term following nadv 81 62 !!---------------------------------------------------------------------- 82 USE wrk_nemo, ONLY: wrk_use, wrk_release 83 USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 63 USE wrk_nemo, ONLY: wrk_use, wrk_release 64 USE wrk_nemo, ONLY: zun => wrk_3d_1, zvn => wrk_3d_2, zwn => wrk_3d_3 ! 3D workspace 65 ! 84 66 INTEGER, INTENT( in ) :: kt ! ocean time-step index 85 67 ! … … 87 69 !!---------------------------------------------------------------------- 88 70 ! 89 IF(.not. wrk_use(3,1,2,3))THEN 90 CALL ctl_stop('tra_adv: ERROR: requested workspace arrays unavailable') 91 RETURN 71 IF(.not. wrk_use(3, 1,2,3) ) THEN 72 CALL ctl_stop('tra_adv: requested workspace arrays unavailable') ; RETURN 92 73 END IF 93 74 ! ! set time step 94 75 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 95 r2dt (:) = rdttra(:) ! = rdtra (restarting with Euler time stepping)76 r2dtra(:) = rdttra(:) ! = rdtra (restarting with Euler time stepping) 96 77 ELSEIF( kt <= nit000 + 1) THEN ! at nit000 or nit000+1 97 r2dt (:) = 2. * rdttra(:)! = 2 rdttra (leapfrog)78 r2dtra(:) = 2._wp * rdttra(:) ! = 2 rdttra (leapfrog) 98 79 ENDIF 99 80 ! … … 118 99 119 100 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 120 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered121 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD122 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL123 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2124 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS125 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST101 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 102 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 103 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 104 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 105 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 106 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 126 107 ! 127 108 CASE (-1 ) !== esopa: test all possibility with control print ==! 128 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )109 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 129 110 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 130 111 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 131 CALL tra_adv_tvd ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )112 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 132 113 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 133 114 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 134 CALL tra_adv_muscl ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsa, jpts )115 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 135 116 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 136 117 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 137 CALL tra_adv_muscl2( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )118 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 138 119 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 139 120 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 140 CALL tra_adv_ubs ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )121 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 141 122 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 142 123 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 143 CALL tra_adv_qck ( kt, 'TRA', r2dt , zun, zvn, zwn, tsb, tsn, tsa, jpts )124 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 144 125 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 145 126 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 150 131 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 151 132 ! 152 IF(.not. wrk_release(3,1,2,3))THEN 153 CALL ctl_stop('tra_adv: ERROR: failed to release workspace arrays') 154 RETURN 155 END IF 133 IF(.not. wrk_release(3,1,2,3) ) CALL ctl_stop('tra_adv: failed to release workspace arrays') 156 134 ! 157 135 END SUBROUTINE tra_adv … … 172 150 !!---------------------------------------------------------------------- 173 151 174 REWIND ( numnam )! Read Namelist namtra_adv : tracer advection scheme175 READ 152 REWIND( numnam ) ! Read Namelist namtra_adv : tracer advection scheme 153 READ ( numnam, namtra_adv ) 176 154 177 155 IF(lwp) THEN ! Namelist print
Note: See TracChangeset
for help on using the changeset viewer.
