- Timestamp:
- 2011-11-17T18:16:05+01:00 (13 years ago)
- Location:
- branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/flo4rk.F90
r3104 r3151 15 15 USE dom_oce ! ocean space and time domain 16 16 USE in_out_manager ! I/O manager 17 USE wrk_nemo_2 ! working array 17 18 18 19 IMPLICIT NONE … … 54 55 INTEGER :: ierror ! error value 55 56 56 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions57 REAL(wp), ALLOCATABLE, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients57 REAL(wp), POINTER, DIMENSION(:) :: zgifl , zgjfl , zgkfl ! index RK positions 58 REAL(wp), POINTER, DIMENSION(:) :: zufl , zvfl , zwfl ! interpolated velocity at the float position 59 REAL(wp), POINTER, DIMENSION(:,:) :: zrkxfl, zrkyfl, zrkzfl ! RK coefficients 59 60 !!--------------------------------------------------------------------- 60 61 ALLOCATE ( zgifl(jpnfl) , zgjfl(jpnfl) , zgkfl(jpnfl) , & 62 zufl(jpnfl) , zvfl(jpnfl) , zwfl(jpnfl) , & 63 zrkxfl(jpnfl,4), zrkyfl(jpnfl,4), zrkzfl(jpnfl,4) , STAT=ierror ) 61 CALL wrk_alloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl) 62 CALL wrk_alloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl ) 64 63 ! 65 64 IF( ierror /= 0 ) THEN … … 157 156 END DO 158 157 ! 159 DEALLOCATE( zgifl , zgjfl , zgkfl ) 160 DEALLOCATE( zufl , zvfl , zwfl ) 161 DEALLOCATE( zrkxfl , zrkyfl , zrkzfl ) 158 CALL wrk_dealloc( jpnfl, zgifl , zgjfl , zgkfl , zufl, zvfl, zwfl) 159 CALL wrk_dealloc( jpnfl, 4, zrkxfl, zrkyfl, zrkzfl ) 162 160 ! 163 161 END SUBROUTINE flo_4rk … … 182 180 INTEGER :: jfl, jind1, jind2, jind3 ! dummy loop indices 183 181 REAL(wp) :: zsumu, zsumv, zsumw ! local scalar 184 INTEGER , DIMENSION(jpnfl):: iilu, ijlu, iklu ! nearest neighbour INDEX-u185 INTEGER , DIMENSION(jpnfl):: iilv, ijlv, iklv ! nearest neighbour INDEX-v186 INTEGER , DIMENSION(jpnfl):: iilw, ijlw, iklw ! nearest neighbour INDEX-w187 INTEGER , DIMENSION(jpnfl,4):: iidu, ijdu, ikdu ! 64 nearest neighbour INDEX-u188 INTEGER , DIMENSION(jpnfl,4):: iidv, ijdv, ikdv ! 64 nearest neighbour INDEX-v189 INTEGER , DIMENSION(jpnfl,4):: iidw, ijdw, ikdw ! 64 nearest neighbour INDEX-w190 REAL(wp) , DIMENSION(jpnfl,4,4,4) :: ztufl , ztvfl , ztwfl ! velocity at choosen time step191 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxu, zlagyu, zlagzu ! Lagrange coefficients192 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxv, zlagyv, zlagzv! - -193 REAL(wp) , DIMENSION(jpnfl,4) :: zlagxw, zlagyw, zlagzw ! - -182 INTEGER , POINTER, DIMENSION(:) :: iilu, ijlu, iklu ! nearest neighbour INDEX-u 183 INTEGER , POINTER, DIMENSION(:) :: iilv, ijlv, iklv ! nearest neighbour INDEX-v 184 INTEGER , POINTER, DIMENSION(:) :: iilw, ijlw, iklw ! nearest neighbour INDEX-w 185 INTEGER , POINTER, DIMENSION(:,:) :: iidu, ijdu, ikdu ! 64 nearest neighbour INDEX-u 186 INTEGER , POINTER, DIMENSION(:,:) :: iidv, ijdv, ikdv ! 64 nearest neighbour INDEX-v 187 INTEGER , POINTER, DIMENSION(:,:) :: iidw, ijdw, ikdw ! 64 nearest neighbour INDEX-w 188 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxu, zlagyu, zlagzu ! Lagrange coefficients 189 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxv, zlagyv, zlagzv ! - - 190 REAL(wp) , POINTER, DIMENSION(:,:) :: zlagxw, zlagyw, zlagzw ! - - 191 REAL(wp) , POINTER, DIMENSION(:,:,:,:) :: ztufl , ztvfl , ztwfl ! velocity at choosen time step 194 192 !!--------------------------------------------------------------------- 195 193 CALL wrk_alloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw ) 194 CALL wrk_alloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw ) 195 CALL wrk_alloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw ) 196 CALL wrk_alloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl ) 197 196 198 ! Interpolation of U velocity 197 199 … … 451 453 END DO 452 454 ! 455 CALL wrk_dealloc( jpnfl, iilu, ijlu, iklu, iilv, ijlv, iklv, iilw, ijlw, iklw ) 456 CALL wrk_dealloc( jpnfl, 4, iidu, ijdu, ikdu, iidv, ijdv, ikdv, iidw, ijdw, ikdw ) 457 CALL wrk_dealloc( jpnfl, 4, zlagxu, zlagyu, zlagzu, zlagxv, zlagyv, zlagzv, zlagxw, zlagyw, zlagzw ) 458 CALL wrk_dealloc( jpnfl, 4, 4, 4, ztufl , ztvfl , ztwfl ) 459 ! 453 460 END SUBROUTINE flo_interp 454 461 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floats.F90
r3104 r3151 23 23 USE floblk ! Trajectories, Blanke scheme (flo_blk routine) 24 24 USE in_out_manager ! I/O manager 25 USE timing ! preformance summary 25 26 26 27 IMPLICIT NONE … … 51 52 !!---------------------------------------------------------------------- 52 53 ! 54 IF( nn_timing == 1 ) CALL timing_start('flo_stp') 55 ! 53 56 IF( ln_flork4 ) THEN ; CALL flo_4rk( kt ) ! Trajectories using a 4th order Runge Kutta scheme 54 57 ELSE ; CALL flo_blk( kt ) ! Trajectories using Blanke' algorithme … … 62 65 ! 63 66 wb(:,:,:) = wn(:,:,:) ! Save the old vertical velocity field 67 ! 68 IF( nn_timing == 1 ) CALL timing_stop('flo_stp') 64 69 ! 65 70 END SUBROUTINE flo_stp … … 76 81 NAMELIST/namflo/ jpnfl, jpnnewflo, ln_rstflo, nn_writefl, nn_stockfl, ln_argo, ln_flork4, ln_ariane, ln_flo_ascii 77 82 !!--------------------------------------------------------------------- 83 ! 84 IF( nn_timing == 1 ) CALL timing_start('flo_init') 78 85 ! 79 86 IF(lwp) WRITE(numout,*) … … 122 129 wb(:,:,:) = wn(:,:,:) ! set wb for computation of floats trajectories at the first time step 123 130 ! 131 IF( nn_timing == 1 ) CALL timing_stop('flo_init') 132 ! 124 133 END SUBROUTINE flo_init 125 134 -
branches/2011/dev_NEMO_MERGE_2011/NEMOGCM/NEMO/OPA_SRC/FLO/floblk.F90
r2715 r3151 17 17 USE in_out_manager ! I/O manager 18 18 USE lib_mpp ! distribued memory computing library 19 USE wrk_nemo_2 ! working array 19 20 20 21 IMPLICIT NONE … … 47 48 INTEGER :: jfl ! dummy loop arguments 48 49 INTEGER :: ind, ifin, iloop 49 INTEGER , DIMENSION ( jpnfl ) :: & 50 REAL(wp) :: & 51 zuinfl,zvinfl,zwinfl, & ! transport across the input face 52 zuoutfl,zvoutfl,zwoutfl, & ! transport across the ouput face 53 zvol, & ! volume of the mesh 54 zsurfz, & ! surface of the face of the mesh 55 zind 56 57 REAL(wp), DIMENSION ( 2 ) :: zsurfx, zsurfy ! surface of the face of the mesh 58 59 INTEGER , POINTER, DIMENSION ( : ) :: & 50 60 iil, ijl, ikl, & ! index of nearest mesh 51 61 iiloc , ijloc, & 52 62 iiinfl, ijinfl, ikinfl, & ! index of input mesh of the float. 53 63 iioutfl, ijoutfl, ikoutfl ! index of output mesh of the float. 54 REAL(wp) , DIMENSION ( jpnfl) :: &64 REAL(wp) , POINTER, DIMENSION ( : ) :: & 55 65 zgifl, zgjfl, zgkfl, & ! position of floats, index on 56 66 ! velocity mesh. … … 64 74 zufl, zvfl, zwfl, & ! interpolated vel. at float position 65 75 zudfl, zvdfl, zwdfl, & ! velocity diff input/output of mesh 66 zgidfl, zgjdfl, zgkdfl ! direction index of float 67 REAL(wp) :: & 68 zuinfl,zvinfl,zwinfl, & ! transport across the input face 69 zuoutfl,zvoutfl,zwoutfl, & ! transport across the ouput face 70 zvol, & ! volume of the mesh 71 zsurfz, & ! surface of the face of the mesh 72 zind 73 REAL(wp), DIMENSION ( 2 ) :: zsurfx, zsurfy ! surface of the face of the mesh 76 zgidfl, zgjdfl, zgkdfl ! direction index of float 74 77 !!--------------------------------------------------------------------- 75 78 CALL wrk_alloc( jpnfl , iil , ijl , ikl , iiloc , ijloc ) 79 CALL wrk_alloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl ) 80 CALL wrk_alloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl , ztyfl , ztzfl , zttfl , zagefl, zagenewfl) 81 CALL wrk_alloc( jpnfl , zufl , zvfl , zwfl , zudfl , zvdfl , zwdfl , zgidfl, zgjdfl, zgkdfl ) 82 76 83 IF( kt == nit000 ) THEN 77 84 IF(lwp) WRITE(numout,*) … … 406 413 ENDIF 407 414 ! 415 CALL wrk_dealloc( jpnfl , iil , ijl , ikl , iiloc , ijloc ) 416 CALL wrk_dealloc( jpnfl , iiinfl, ijinfl, ikinfl, iioutfl, ijoutfl, ikoutfl ) 417 CALL wrk_dealloc( jpnfl , zgifl , zgjfl , zgkfl , ztxfl , ztyfl , ztzfl , zttfl , zagefl, zagenewfl) 418 CALL wrk_dealloc( jpnfl , zufl , zvfl , zwfl , zudfl , zvdfl , zwdfl , zgidfl, zgjdfl, zgkdfl ) 419 ! 408 420 END SUBROUTINE flo_blk 409 421
Note: See TracChangeset
for help on using the changeset viewer.