Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 (modified) (5 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90
r2715 r3294 27 27 USE prtctl ! Print control 28 28 USE lib_mpp ! MPP library 29 USE wrk_nemo ! Memory Allocation 30 USE timing ! Timing 31 29 32 30 33 IMPLICIT NONE … … 62 65 !! ** Method : - Update (ua,va) with the advection term following nadv 63 66 !!---------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released65 USE wrk_nemo, ONLY: zun => wrk_3d_1 , zvn => wrk_3d_2 , zwn => wrk_3d_3 ! 3D workspace66 67 ! 67 68 INTEGER, INTENT( in ) :: kt ! ocean time-step index 68 69 ! 69 70 INTEGER :: jk ! dummy loop index 70 !!---------------------------------------------------------------------- 71 ! 72 IF( wrk_in_use(3, 1,2,3) ) THEN 73 CALL ctl_stop('tra_adv: requested workspace arrays unavailable') ; RETURN 74 ENDIF 71 REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 72 !!---------------------------------------------------------------------- 73 ! 74 IF( nn_timing == 1 ) CALL timing_start('tra_adv') 75 ! 76 CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 75 77 ! ! set time step 76 78 IF( neuler == 0 .AND. kt == nit000 ) THEN ! at nit000 … … 93 95 ! 94 96 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & 95 & CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRA' )! add the eiv transport (if necessary)97 & CALL tra_adv_eiv( kt, nit000, zun, zvn, zwn, 'TRA' ) ! add the eiv transport (if necessary) 96 98 ! 97 99 CALL iom_put( "uocetr_eff", zun ) ! output effective transport … … 100 102 101 103 SELECT CASE ( nadv ) !== compute advection trend and add it to general trend ==! 102 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered103 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD104 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL105 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2106 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS107 CASE ( 6 ) ; CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST104 CASE ( 1 ) ; CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! 2nd order centered 105 CASE ( 2 ) ; CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! TVD 106 CASE ( 3 ) ; CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) ! MUSCL 107 CASE ( 4 ) ; CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! MUSCL2 108 CASE ( 5 ) ; CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! UBS 109 CASE ( 6 ) ; CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) ! QUICKEST 108 110 ! 109 111 CASE (-1 ) !== esopa: test all possibility with control print ==! 110 CALL tra_adv_cen2 ( kt, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts )112 CALL tra_adv_cen2 ( kt, nit000, 'TRA', zun, zvn, zwn, tsb, tsn, tsa, jpts ) 111 113 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv0 - Ta: ', mask1=tmask, & 112 114 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 113 CALL tra_adv_tvd ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )115 CALL tra_adv_tvd ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 114 116 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv1 - Ta: ', mask1=tmask, & 115 117 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 116 CALL tra_adv_muscl ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts )118 CALL tra_adv_muscl ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsa, jpts ) 117 119 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv3 - Ta: ', mask1=tmask, & 118 120 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 119 CALL tra_adv_muscl2( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )121 CALL tra_adv_muscl2( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 120 122 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv4 - Ta: ', mask1=tmask, & 121 123 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 122 CALL tra_adv_ubs ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )124 CALL tra_adv_ubs ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 123 125 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv5 - Ta: ', mask1=tmask, & 124 126 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 CALL tra_adv_qck ( kt, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts )127 CALL tra_adv_qck ( kt, nit000, 'TRA', r2dtra, zun, zvn, zwn, tsb, tsn, tsa, jpts ) 126 128 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv6 - Ta: ', mask1=tmask, & 127 129 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) … … 132 134 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 133 135 ! 134 IF( wrk_not_released(3,1,2,3) ) CALL ctl_stop('tra_adv: failed to release workspace arrays') 135 ! 136 IF( nn_timing == 1 ) CALL timing_stop('tra_adv') 137 ! 138 CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 139 ! 136 140 END SUBROUTINE tra_adv 137 141
Note: See TracChangeset
for help on using the changeset viewer.
