Changeset 900 for trunk/NEMO/C1D_SRC/dynnxt_c1d.F90
- Timestamp:
- 2008-04-22T20:13:41+02:00 (16 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/C1D_SRC/dynnxt_c1d.F90
r899 r900 1 MODULE dynnxt 1d1 MODULE dynnxt_c1d 2 2 !!====================================================================== 3 !! *** MODULE dynnxt 1d ***3 !! *** MODULE dynnxt_c1d *** 4 4 !! Ocean dynamics: time stepping in 1D configuration 5 5 !!====================================================================== 6 !! History : 2.0 ! 2004-10 (C. Ethe) Original code from dynnxt.F90 7 !! 3.0 ! 2008-04 (G.madec) Style only 8 !!---------------------------------------------------------------------- 6 9 #if defined key_c1d 7 10 !!---------------------------------------------------------------------- 8 !! 'key_c1d' 1D Configuration11 !! 'key_c1d' 1D Configuration 9 12 !!---------------------------------------------------------------------- 10 13 !!---------------------------------------------------------------------- 11 !! dyn_nxt_ 1d: update the horizontal velocity from the momentum trend14 !! dyn_nxt_c1d : update the horizontal velocity from the momentum trend 12 15 !!---------------------------------------------------------------------- 13 !! * Modules used14 16 USE oce ! ocean dynamics and tracers 15 17 USE dom_oce ! ocean space and time domain … … 21 23 PRIVATE 22 24 23 !! * Accessibility 24 PUBLIC dyn_nxt_1d ! routine called by step.F90 25 PUBLIC dyn_nxt_c1d ! routine called by step.F90 26 !!---------------------------------------------------------------------- 27 !! NEMO/C1D 3.0 , LOCEAN-IPSL (2008) 28 !! $Id:$ 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 25 30 !!---------------------------------------------------------------------- 26 31 27 32 CONTAINS 28 33 29 SUBROUTINE dyn_nxt_ 1d ( kt )34 SUBROUTINE dyn_nxt_c1d ( kt ) 30 35 !!---------------------------------------------------------------------- 31 !! *** ROUTINE dyn_nxt_ 1d ***36 !! *** ROUTINE dyn_nxt_c1d *** 32 37 !! 33 38 !! ** Purpose : Compute the after horizontal velocity from the … … 46 51 !! ** Action : - Update ub,vb arrays, the before horizontal velocity 47 52 !! - Update un,vn arrays, the now horizontal velocity 53 !!---------------------------------------------------------------------- 54 INTEGER, INTENT( in ) :: kt ! ocean time-step index 48 55 !! 49 !! History : 50 !! ! 87-02 (P. Andrich, D. L Hostis) Original code 51 !! ! 90-10 (C. Levy, G. Madec) 52 !! ! 93-03 (M. Guyon) symetrical conditions 53 !! ! 97-02 (G. Madec & M. Imbard) opa, release 8.0 54 !! ! 97-04 (A. Weaver) Euler forward step 55 !! ! 97-06 (G. Madec) lateral boudary cond., lbc routine 56 !! 8.5 ! 02-08 (G. Madec) F90: Free form and module 57 !! ! 04-10 (C. Ethe) 1D configuration 58 !!---------------------------------------------------------------------- 59 !! * Arguments 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 62 !! * Local declarations 63 INTEGER :: ji, jj, jk ! dummy loop indices 56 INTEGER :: jk ! dummy loop indices 64 57 REAL(wp) :: z2dt ! temporary scalar 65 !!----------------------------------------------------------------------66 !! OPA 9.0 , LOCEAN-IPSL (2005)67 !! $Header$68 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt69 58 !!---------------------------------------------------------------------- 70 59 71 60 IF( kt == nit000 ) THEN 72 61 IF(lwp) WRITE(numout,*) 73 IF(lwp) WRITE(numout,*) 'dyn_nxt_ 1d : time stepping on 1D configuation'62 IF(lwp) WRITE(numout,*) 'dyn_nxt_c1d : time stepping on 1D configuation' 74 63 IF(lwp) WRITE(numout,*) '~~~~~~~' 75 64 ENDIF … … 83 72 CALL lbc_lnk( va, 'V', -1. ) 84 73 85 ! ! =============== 86 DO jk = 1, jpkm1 ! Horizontal slab 87 ! ! =============== 88 ! Next velocity 89 ! ------------- 90 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 91 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 92 ! Leap-frog time stepping 93 ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk) 94 va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk) 95 END DO 96 END DO 97 ! ! =============== 98 END DO ! End of slab 99 ! ! =============== 74 DO jk = 1, jpkm1 ! Next Velocity 75 ua(:,:,jk) = ( ub(:,:,jk) + z2dt * ua(:,:,jk) ) * umask(:,:,jk) 76 va(:,:,jk) = ( vb(:,:,jk) + z2dt * va(:,:,jk) ) * vmask(:,:,jk) 77 END DO 100 78 101 ! ! =============== 102 DO jk = 1, jpkm1 ! Horizontal slab 103 ! ! =============== 104 ! Time filter and swap of dynamics arrays 105 ! ------------------------------------------ 106 IF( neuler == 0 .AND. kt == nit000 ) THEN 107 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 108 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 109 ! Euler (forward) time stepping 110 ub(ji,jj,jk) = un(ji,jj,jk) 111 vb(ji,jj,jk) = vn(ji,jj,jk) 112 un(ji,jj,jk) = ua(ji,jj,jk) 113 vn(ji,jj,jk) = va(ji,jj,jk) 114 END DO 115 END DO 116 ELSE 117 DO jj = 1, jpj ! caution: don't use (:,:) for this loop 118 DO ji = 1, jpi ! it causes optimization problems on NEC in auto-tasking 119 ! Leap-frog time stepping 120 ub(ji,jj,jk) = atfp * ( ub(ji,jj,jk) + ua(ji,jj,jk) ) + atfp1 * un(ji,jj,jk) 121 vb(ji,jj,jk) = atfp * ( vb(ji,jj,jk) + va(ji,jj,jk) ) + atfp1 * vn(ji,jj,jk) 122 un(ji,jj,jk) = ua(ji,jj,jk) 123 vn(ji,jj,jk) = va(ji,jj,jk) 124 END DO 125 END DO 79 DO jk = 1, jpkm1 ! Time filter and swap of dynamics arrays 80 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler (forward) time stepping 81 ub(:,:,:) = un(:,:,:) 82 vb(:,:,:) = vn(:,:,:) 83 un(:,:,:) = ua(:,:,:) 84 vn(:,:,:) = va(:,:,:) 85 ELSE ! Leap-frog time stepping 86 ub(:,:,:) = atfp * ( ub(:,:,:) + ua(:,:,:) ) + atfp1 * un(:,:,:) 87 vb(:,:,:) = atfp * ( vb(:,:,:) + va(:,:,:) ) + atfp1 * vn(:,:,:) 88 un(:,:,:) = ua(:,:,:) 89 vn(:,:,:) = va(:,:,:) 126 90 ENDIF 127 ! ! =============== 128 END DO ! End of slab 129 ! ! =============== 91 END DO 130 92 131 IF(ln_ctl) THEN132 CALL prt_ctl(tab3d_1=un, clinfo1=' nxt_1d - Un: ', mask1=umask, &133 & tab3d_2=vn, clinfo2=' Vn: ', mask2=vmask)134 ENDIF93 IF(ln_ctl) CALL prt_ctl( tab3d_1=un, clinfo1=' nxt_c1d - Un: ', mask1=umask, & 94 & tab3d_2=vn, clinfo2=' Vn: ' , mask2=vmask ) 95 ! 96 END SUBROUTINE dyn_nxt_c1d 135 97 136 ! IF(l_ctl) WRITE(numout,*) ' nxt - Un: ', SUM(un(2:nictl,2:njctl,1:jpkm1)*umask(2:nictl,2:njctl,1:jpkm1)), &137 ! & ' Vn: ', SUM(vn(2:nictl,2:njctl,1:jpkm1)*vmask(2:nictl,2:njctl,1:jpkm1))138 139 END SUBROUTINE dyn_nxt_1d140 98 #else 141 99 !!---------------------------------------------------------------------- … … 143 101 !!---------------------------------------------------------------------- 144 102 CONTAINS 145 SUBROUTINE dyn_nxt_ 1d ( kt )146 WRITE(*,*) 'dyn_nxt_ 1d: You should not have seen this print! error?', kt147 END SUBROUTINE dyn_nxt_ 1d103 SUBROUTINE dyn_nxt_c1d ( kt ) 104 WRITE(*,*) 'dyn_nxt_c1d: You should not have seen this print! error?', kt 105 END SUBROUTINE dyn_nxt_c1d 148 106 #endif 107 149 108 !!====================================================================== 150 END MODULE dynnxt 1d109 END MODULE dynnxt_c1d
Note: See TracChangeset
for help on using the changeset viewer.