Changeset 3294 for trunk/NEMOGCM/NEMO/OPA_SRC/IOM
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/IOM
- Files:
-
- 4 edited
-
in_out_manager.F90 (modified) (3 diffs)
-
iom.F90 (modified) (5 diffs)
-
prtctl.F90 (modified) (12 diffs)
-
restart.F90 (modified) (7 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/in_out_manager.F90
r2715 r3294 2 2 !!====================================================================== 3 3 !! *** MODULE in_out_manager *** 4 !! Ocean physics: vertical mixing coefficient compute from the tke 5 !! turbulent closure parameterization 4 !! I/O manager utilities : Defines run parameters together with logical units 6 5 !!===================================================================== 7 6 !! History : 1.0 ! 2002-06 (G. Madec) original code … … 87 86 !!---------------------------------------------------------------------- 88 87 LOGICAL :: ln_ctl = .FALSE. !: run control for debugging 88 INTEGER :: nn_timing = 0 !: run control for timing 89 89 INTEGER :: nn_print = 0 !: level of print (0 no print) 90 90 INTEGER :: nn_ictls = 0 !: Start i indice for the SUM control … … 105 105 !! logical units 106 106 !!---------------------------------------------------------------------- 107 INTEGER :: numstp = -1 !: logical unit for time step 108 INTEGER :: numout = 6 !: logical unit for output print 109 INTEGER :: numnam = -1 !: logical unit for namelist 110 INTEGER :: numnam_ice = -1 !: logical unit for ice namelist 111 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 112 INTEGER :: numsol = -1 !: logical unit for solver statistics 107 INTEGER :: numstp = -1 !: logical unit for time step 108 INTEGER :: numtime = -1 !: logical unit for timing 109 INTEGER :: numout = 6 !: logical unit for output print 110 INTEGER :: numnam = -1 !: logical unit for namelist 111 INTEGER :: numnam_ice = -1 !: logical unit for ice namelist 112 INTEGER :: numevo_ice = -1 !: logical unit for ice variables (temp. evolution) 113 INTEGER :: numsol = -1 !: logical unit for solver statistics 114 INTEGER :: numdct_in = -1 !: logical unit for transports computing 115 INTEGER :: numdct_vol = -1 !: logical unit for voulume transports output 116 INTEGER :: numdct_heat = -1 !: logical unit for heat transports output 117 INTEGER :: numdct_salt = -1 !: logical unit for salt transports output 118 INTEGER :: numfl = -1 !: logical unit for floats ascii output 119 INTEGER :: numflo = -1 !: logical unit for floats ascii output 113 120 114 121 !!---------------------------------------------------------------------- -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r2715 r3294 19 19 !!-------------------------------------------------------------------- 20 20 USE dom_oce ! ocean space and time domain 21 USE flo_oce ! floats module declarations 21 22 USE lbclnk ! lateal boundary condition / mpp exchanges 22 23 USE iom_def ! iom variables definitions … … 48 49 PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d 49 50 PRIVATE iom_g0d, iom_g1d, iom_g2d, iom_g3d, iom_get_123d 50 PRIVATE iom_p 2d, iom_p3d51 PRIVATE iom_p1d, iom_p2d, iom_p3d 51 52 #if defined key_iomput 52 53 PRIVATE set_grid … … 63 64 END INTERFACE 64 65 INTERFACE iom_put 65 MODULE PROCEDURE iom_p0d, iom_p 2d, iom_p3d66 MODULE PROCEDURE iom_p0d, iom_p1d, iom_p2d, iom_p3d 66 67 END INTERFACE 67 68 #if defined key_iomput … … 115 116 CALL event__set_vert_axis( "depthv", gdept_0 ) 116 117 CALL event__set_vert_axis( "depthw", gdepw_0 ) 118 # if defined key_floats 119 CALL event__set_vert_axis( "nfloat", REAL(nfloat,wp) ) 120 # endif 117 121 118 122 ! automatic definitions of some of the xml attributs … … 961 965 #endif 962 966 END SUBROUTINE iom_p0d 967 968 SUBROUTINE iom_p1d( cdname, pfield1d ) 969 CHARACTER(LEN=*) , INTENT(in) :: cdname 970 REAL(wp), DIMENSION(:), INTENT(in) :: pfield1d 971 INTEGER :: jpz 972 #if defined key_iomput 973 jpz=SIZE(pfield1d) 974 CALL event__write_field3D( cdname, RESHAPE( (/pfield1d/), (/1,1,jpz/) ) ) 975 #else 976 IF( .FALSE. ) WRITE(numout,*) cdname, pfield1d ! useless test to avoid compilation warnings 977 #endif 978 END SUBROUTINE iom_p1d 963 979 964 980 SUBROUTINE iom_p2d( cdname, pfield2d ) -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/prtctl.F90
r2715 r3294 5 5 !!====================================================================== 6 6 !! History : 9.0 ! 05-07 (C. Talandier) original code 7 !! 3.4 ! 11-11 (C. Harris) decomposition changes for running with CICE 7 8 !!---------------------------------------------------------------------- 8 9 USE dom_oce ! ocean space and time domain variables 9 10 USE in_out_manager ! I/O manager 10 11 USE lib_mpp ! distributed memory computing 12 USE wrk_nemo ! work arrays 11 13 12 14 IMPLICIT NONE … … 73 75 !! clinfo3 : additional information 74 76 !!---------------------------------------------------------------------- 75 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released76 USE wrk_nemo, ONLY: ztab2d_1 => wrk_2d_30 , ztab2d_2 => wrk_2d_3177 USE wrk_nemo, ONLY: zmask1 => wrk_3d_11 , zmask2 => wrk_3d_1278 USE wrk_nemo, ONLY: ztab3d_1 => wrk_3d_13 , ztab3d_2 => wrk_3d_1479 !80 77 REAL(wp), DIMENSION(:,:) , INTENT(in), OPTIONAL :: tab2d_1 81 78 REAL(wp), DIMENSION(:,:,:), INTENT(in), OPTIONAL :: tab3d_1 … … 93 90 INTEGER :: overlap, jn, sind, eind, kdir,j_id 94 91 REAL(wp) :: zsum1, zsum2, zvctl1, zvctl2 95 !!---------------------------------------------------------------------- 96 97 IF( wrk_in_use(2, 30,31) .OR. wrk_in_use(3, 11,12,13,14) ) THEN 98 CALL ctl_stop('prt_ctl : requested workspace arrays unavailable') ; RETURN 99 ENDIF 92 REAL(wp), POINTER, DIMENSION(:,:) :: ztab2d_1, ztab2d_2 93 REAL(wp), POINTER, DIMENSION(:,:,:) :: zmask1, zmask2, ztab3d_1, ztab3d_2 94 !!---------------------------------------------------------------------- 95 96 CALL wrk_alloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 97 CALL wrk_alloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 100 98 101 99 ! Arrays, scalars initialization … … 125 123 IF( PRESENT(mask2) ) zmask2 (:,:,:) = mask2 (:,:,:) 126 124 127 IF( lk_mpp ) THEN ! processor number125 IF( lk_mpp .AND. jpnij > 1 ) THEN ! processor number 128 126 sind = narea 129 127 eind = narea 130 ELSE ! processors total number128 ELSE ! processors total number 131 129 sind = 1 132 130 eind = ijsplt … … 139 137 ! Set indices for the SUM control 140 138 IF( .NOT. lsp_area ) THEN 141 IF (lk_mpp ) THEN139 IF (lk_mpp .AND. jpnij > 1) THEN 142 140 nictls = MAX( 1, nlditl(jn) - overlap ) 143 141 nictle = nleitl(jn) + overlap * MIN( 1, nlcitl(jn) - nleitl(jn)) … … 204 202 ENDDO 205 203 206 IF( wrk_not_released(2, 30,31) .OR. &207 wrk_not_released(3, 11,12,13,14) ) CALL ctl_stop('prt_ctl: failed to release workspace arrays')204 CALL wrk_dealloc( jpi,jpj, ztab2d_1, ztab2d_2 ) 205 CALL wrk_dealloc( jpi,jpj,jpk, zmask1, zmask2, ztab3d_1, ztab3d_2 ) 208 206 ! 209 207 END SUBROUTINE prt_ctl … … 231 229 !!---------------------------------------------------------------------- 232 230 233 IF( lk_mpp ) THEN ! processor number231 IF( lk_mpp .AND. jpnij > 1 ) THEN ! processor number 234 232 sind = narea 235 233 eind = narea 236 ELSE ! total number of processors234 ELSE ! total number of processors 237 235 sind = 1 238 236 eind = ijsplt … … 296 294 ktime = 1 297 295 298 IF( lk_mpp ) THEN296 IF( lk_mpp .AND. jpnij > 1 ) THEN 299 297 sind = narea 300 298 eind = narea … … 434 432 435 433 ijpi = ( jpiglo-2*jpreci + (isplt-1) ) / isplt + 2*jpreci 434 #if defined key_nemocice_decomp 435 ijpj = ( jpjglo+1-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 436 #else 436 437 ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 438 #endif 437 439 438 440 ALLOCATE(ilcitl (isplt,jsplt)) … … 445 447 446 448 IF( irestil == 0 ) irestil = isplt 449 #if defined key_nemocice_decomp 450 451 ! In order to match CICE the size of domains in NEMO has to be changed 452 ! The last line of blocks (west) will have fewer points 453 DO jj = 1, jsplt 454 DO ji=1, isplt-1 455 ilcitl(ji,jj) = ijpi 456 END DO 457 ilcitl(isplt,jj) = jpiglo - (isplt - 1) * (ijpi - nrecil) 458 END DO 459 460 #else 461 447 462 DO jj = 1, jsplt 448 463 DO ji = 1, irestil … … 453 468 END DO 454 469 END DO 470 471 #endif 455 472 456 473 IF( irestjl == 0 ) irestjl = jsplt 474 #if defined key_nemocice_decomp 475 476 ! Same change to domains in North-South direction as in East-West. 477 DO ji = 1, isplt 478 DO jj=1, jsplt-1 479 ilcjtl(ji,jj) = ijpj 480 END DO 481 ilcjtl(ji,jsplt) = jpjglo - (jsplt - 1) * (ijpj - nrecjl) 482 END DO 483 484 #else 485 457 486 DO ji = 1, isplt 458 487 DO jj = 1, irestjl … … 463 492 END DO 464 493 END DO 465 494 495 #endif 466 496 zidom = nrecil 467 497 DO ji = 1, isplt -
trunk/NEMOGCM/NEMO/OPA_SRC/IOM/restart.F90
r2528 r3294 24 24 USE trdmld_oce ! ocean active mixed layer tracers trends variables 25 25 USE domvvl ! variable volume 26 USE traswp ! swap from 4D T-S to 3D T & S and vice versa27 26 28 27 IMPLICIT NONE … … 117 116 CALL iom_rstput( kt, nitrst, numrow, 'ub' , ub ) ! before fields 118 117 CALL iom_rstput( kt, nitrst, numrow, 'vb' , vb ) 119 CALL iom_rstput( kt, nitrst, numrow, 'tb' , t b)120 CALL iom_rstput( kt, nitrst, numrow, 'sb' , sb)118 CALL iom_rstput( kt, nitrst, numrow, 'tb' , tsb(:,:,:,jp_tem) ) 119 CALL iom_rstput( kt, nitrst, numrow, 'sb' , tsb(:,:,:,jp_sal) ) 121 120 CALL iom_rstput( kt, nitrst, numrow, 'rotb' , rotb ) 122 121 CALL iom_rstput( kt, nitrst, numrow, 'hdivb' , hdivb ) … … 126 125 CALL iom_rstput( kt, nitrst, numrow, 'un' , un ) ! now fields 127 126 CALL iom_rstput( kt, nitrst, numrow, 'vn' , vn ) 128 CALL iom_rstput( kt, nitrst, numrow, 'tn' , t n)129 CALL iom_rstput( kt, nitrst, numrow, 'sn' , sn)127 CALL iom_rstput( kt, nitrst, numrow, 'tn' , tsn(:,:,:,jp_tem) ) 128 CALL iom_rstput( kt, nitrst, numrow, 'sn' , tsn(:,:,:,jp_sal) ) 130 129 CALL iom_rstput( kt, nitrst, numrow, 'rotn' , rotn ) 131 130 CALL iom_rstput( kt, nitrst, numrow, 'hdivn' , hdivn ) … … 186 185 CALL iom_get( numror, jpdom_autoglo, 'ub' , ub ) ! before fields 187 186 CALL iom_get( numror, jpdom_autoglo, 'vb' , vb ) 188 CALL iom_get( numror, jpdom_autoglo, 'tb' , t b)189 CALL iom_get( numror, jpdom_autoglo, 'sb' , sb)187 CALL iom_get( numror, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem) ) 188 CALL iom_get( numror, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal) ) 190 189 CALL iom_get( numror, jpdom_autoglo, 'rotb' , rotb ) 191 190 CALL iom_get( numror, jpdom_autoglo, 'hdivb' , hdivb ) … … 195 194 CALL iom_get( numror, jpdom_autoglo, 'un' , un ) ! now fields 196 195 CALL iom_get( numror, jpdom_autoglo, 'vn' , vn ) 197 CALL iom_get( numror, jpdom_autoglo, 'tn' , t n)198 CALL iom_get( numror, jpdom_autoglo, 'sn' , sn)196 CALL iom_get( numror, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem) ) 197 CALL iom_get( numror, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal) ) 199 198 CALL iom_get( numror, jpdom_autoglo, 'rotn' , rotn ) 200 199 CALL iom_get( numror, jpdom_autoglo, 'hdivn' , hdivn ) … … 205 204 CALL iom_get( numror, jpdom_autoglo, 'rhd' , rhd ) ! now in situ density anomaly 206 205 ELSE 207 CALL tra_swap208 206 CALL eos( tsn, rhd ) ! compute rhd 209 207 ENDIF … … 211 209 ! 212 210 IF( neuler == 0 ) THEN ! Euler restart (neuler=0) 213 tb (:,:,:) = tn (:,:,:) ! all before fields set to now values 214 sb (:,:,:) = sn (:,:,:) 215 ub (:,:,:) = un (:,:,:) 216 vb (:,:,:) = vn (:,:,:) 217 rotb (:,:,:) = rotn (:,:,:) 218 hdivb(:,:,:) = hdivn(:,:,:) 219 sshb (:,:) = sshn (:,:) 211 tsb (:,:,:,:) = tsn (:,:,:,:) ! all before fields set to now values 212 ub (:,:,:) = un (:,:,:) 213 vb (:,:,:) = vn (:,:,:) 214 rotb (:,:,:) = rotn (:,:,:) 215 hdivb(:,:,:) = hdivn(:,:,:) 216 sshb (:,:) = sshn (:,:) 220 217 IF( lk_vvl ) THEN 221 218 DO jk = 1, jpk
Note: See TracChangeset
for help on using the changeset viewer.
