Changeset 4258 for branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC
- Timestamp:
- 2013-11-19T16:54:37+01:00 (11 years ago)
- Location:
- branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 24 edited
-
ASM/asminc.F90 (modified) (1 diff)
-
BDY/bdyice_lim2.F90 (modified) (1 diff, 1 prop)
-
C1D/step_c1d.F90 (modified) (2 diffs)
-
DIA/diadct.F90 (modified) (5 diffs)
-
DIA/diahsb.F90 (modified) (11 diffs)
-
DIA/diaptr.F90 (modified) (3 diffs)
-
DOM/closea.F90 (modified) (3 diffs)
-
DOM/daymod.F90 (modified) (1 diff)
-
DOM/domzgr.F90 (modified) (3 diffs)
-
DYN/dynspg_flt.F90 (modified) (4 diffs)
-
ICB/icb_oce.F90 (modified) (3 diffs)
-
ICB/icbini.F90 (modified) (1 diff)
-
ICB/icbstp.F90 (modified) (1 diff)
-
IOM/iom.F90 (modified) (21 diffs)
-
LBC/lbclnk.F90 (modified) (3 diffs)
-
LBC/lib_mpp.F90 (modified) (24 diffs)
-
LBC/mppini_2.h90 (modified) (2 diffs)
-
SBC/geo2ocean.F90 (modified) (3 diffs)
-
SBC/sbc_oce.F90 (modified) (2 diffs)
-
SBC/sbccpl.F90 (modified) (5 diffs)
-
SBC/sbcmod.F90 (modified) (3 diffs)
-
SOL/solmat.F90 (modified) (2 diffs)
-
TRA/eosbn2.F90 (modified) (3 diffs)
-
step.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r3785 r4258 682 682 ! used to prevent the applied increments taking the temperature below the local freezing point 683 683 684 #if defined key_cice 685 fzptnz(:,:,:) = -1.8_wp 686 #else 687 DO jk = 1, jpk 688 DO jj = 1, jpj 689 DO ji = 1, jpk 690 fzptnz (ji,jj,jk) = ( -0.0575_wp + 1.710523e-3_wp * SQRT( tsn(ji,jj,jk,jp_sal) ) & 691 - 2.154996e-4_wp * tsn(ji,jj,jk,jp_sal) ) * tsn(ji,jj,jk,jp_sal) & 692 - 7.53e-4_wp * fsdepw(ji,jj,jk) ! (pressure in dbar) 693 END DO 694 END DO 695 END DO 696 #endif 684 DO jk=1, jpkm1 685 fzptnz (:,:,jk) = tfreez( tsn(:,:,jk,jp_sal), fsdept(:,:,jk) ) 686 ENDDO 697 687 698 688 IF ( ln_asmiau ) THEN -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90
- Property svn:keywords set to Id
r4254 r4258 32 32 !!---------------------------------------------------------------------- 33 33 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 34 !! $Id : bdyice_lim2.F90 4223 2013-11-15 17:21:46Z cbricaud$34 !! $Id$ 35 35 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 36 36 !!---------------------------------------------------------------------- -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/C1D/step_c1d.F90
r3680 r4258 59 59 60 60 indic = 0 ! reset to no error condition 61 IF( kstp == nit000 ) CALL iom_init ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 61 62 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 62 CALL iom_setkt( kstp ) ! say to iom that we are at time step kstp63 CALL iom_setkt( kstp - nit000 + 1 ) ! say to iom that we are at time step kstp 63 64 64 65 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 106 107 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 107 108 CALL dia_wri( kstp ) ! ocean model: outputs 109 IF( lk_diahth ) CALL dia_hth( kstp ) ! Thermocline depth (20°C) 110 108 111 109 112 #if defined key_top -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA/diadct.F90
r3680 r4258 42 42 #endif 43 43 #if defined key_lim3 44 USE ice_3 44 USE par_ice 45 USE ice 45 46 #endif 46 47 USE domvvl … … 484 485 ijglo = secs(jsec)%listPoint(jpt)%J + jpjzoom - 1 + njmpp - 1 485 486 WRITE(numout,*)' # I J : ',iiglo,ijglo 487 CALL FLUSH(numout) 486 488 ENDDO 487 489 ENDIF … … 606 608 607 609 !! * Local variables 608 INTEGER :: jk, jseg, jclass, &!loop on level/segment/classes610 INTEGER :: jk, jseg, jclass,jl, &!loop on level/segment/classes/ice categories 609 611 isgnu, isgnv ! 610 612 REAL(wp) :: zumid, zvmid, &!U/V velocity on a cell segment … … 771 773 772 774 zTnorm=zumid_ice*e2u(k%I,k%J)+zvmid_ice*e1v(k%I,k%J) 773 775 776 #if defined key_lim2 774 777 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 775 778 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) & … … 778 781 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 779 782 (1.0 - frld(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J)) 783 #endif 784 #if defined key_lim3 785 DO jl=1,jpl 786 transports_2d(1,jsec,jseg) = transports_2d(1,jsec,jseg) + (zTnorm)* & 787 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) * & 788 ( ht_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) + & 789 ht_s(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) ) 790 791 transports_2d(2,jsec,jseg) = transports_2d(2,jsec,jseg) + (zTnorm)* & 792 a_i(sec%listPoint(jseg)%I,sec%listPoint(jseg)%J,jl) 793 ENDDO 794 #endif 780 795 781 796 ENDIF !end of ice case -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA/diahsb.F90
r3625 r4258 21 21 USE bdy_par ! (for lk_bdy) 22 22 USE timing ! preformance summary 23 USE lib_fortran 24 USE sbcrnf 23 25 24 26 IMPLICIT NONE … … 33 35 REAL(dp) :: surf_tot , vol_tot ! 34 36 REAL(dp) :: frc_t , frc_s , frc_v ! global forcing trends 37 REAL(dp) :: frc_wn_t , frc_wn_s ! global forcing trends 35 38 REAL(dp) :: fact1 ! conversion factors 36 39 REAL(dp) :: fact21 , fact22 ! - - … … 38 41 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: surf , ssh_ini ! 39 42 REAL(dp), DIMENSION(:,:,:), ALLOCATABLE :: hc_loc_ini, sc_loc_ini, e3t_ini ! 43 REAL(dp), DIMENSION(:,:) , ALLOCATABLE :: ssh_hc_loc_ini, ssh_sc_loc_ini 40 44 41 45 !! * Substitutions … … 67 71 INTEGER :: jk ! dummy loop indice 68 72 REAL(dp) :: zdiff_hc , zdiff_sc ! heat and salt content variations 73 REAL(dp) :: zdiff_hc1 , zdiff_sc1 ! heat and salt content variations of ssh 69 74 REAL(dp) :: zdiff_v1 , zdiff_v2 ! volume variation 75 REAL(dp) :: zerr_hc1 , zerr_sc1 ! Non conservation due to free surface 70 76 REAL(dp) :: z1_rau0 ! local scalars 71 77 REAL(dp) :: zdeltat ! - - 72 78 REAL(dp) :: z_frc_trd_t , z_frc_trd_s ! - - 73 79 REAL(dp) :: z_frc_trd_v ! - - 80 REAL(dp) :: z_wn_trd_t , z_wn_trd_s ! - - 81 REAL(dp) :: z_ssh_hc , z_ssh_sc ! - - 74 82 !!--------------------------------------------------------------------------- 75 83 IF( nn_timing == 1 ) CALL timing_start('dia_hsb') … … 79 87 ! ------------------------- ! 80 88 z1_rau0 = 1.e0 / rau0 81 z_frc_trd_v = z1_rau0 * SUM( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 82 z_frc_trd_t = SUM( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 83 z_frc_trd_s = SUM( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 89 z_frc_trd_v = z1_rau0 * glob_sum( - ( emp(:,:) - rnf(:,:) ) * surf(:,:) ) ! volume fluxes 90 z_frc_trd_t = glob_sum( sbc_tsc(:,:,jp_tem) * surf(:,:) ) ! heat fluxes 91 z_frc_trd_s = glob_sum( sbc_tsc(:,:,jp_sal) * surf(:,:) ) ! salt fluxes 92 ! Add runoff heat & salt input 93 IF( ln_rnf ) z_frc_trd_t = z_frc_trd_t + glob_sum( rnf_tsc(:,:,jp_tem) * surf(:,:) ) 94 IF( ln_rnf_sal) z_frc_trd_s = z_frc_trd_s + glob_sum( rnf_tsc(:,:,jp_sal) * surf(:,:) ) 84 95 ! Add penetrative solar radiation 85 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qsr (:,:) * surf(:,:) )96 IF( ln_traqsr ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * glob_sum( qsr (:,:) * surf(:,:) ) 86 97 ! Add geothermal heat flux 87 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + r1_rau0_rcp * SUM( qgh_trd0(:,:) * surf(:,:) ) 88 IF( lk_mpp ) THEN 89 CALL mpp_sum( z_frc_trd_v ) 90 CALL mpp_sum( z_frc_trd_t ) 91 ENDIF 98 IF( ln_trabbc ) z_frc_trd_t = z_frc_trd_t + glob_sum( qgh_trd0(:,:) * surf(:,:) ) 99 IF( .NOT. lk_vvl ) THEN 100 z_wn_trd_t = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_tem) ) 101 z_wn_trd_s = - glob_sum( surf(:,:) * wn(:,:,1) * tsb(:,:,1,jp_sal) ) 102 ENDIF 103 92 104 frc_v = frc_v + z_frc_trd_v * rdt 93 105 frc_t = frc_t + z_frc_trd_t * rdt 94 106 frc_s = frc_s + z_frc_trd_s * rdt 107 ! ! Advection flux through fixed surface (z=0) 108 IF( .NOT. lk_vvl ) THEN 109 frc_wn_t = frc_wn_t + z_wn_trd_t * rdt 110 frc_wn_s = frc_wn_s + z_wn_trd_s * rdt 111 ENDIF 95 112 96 113 ! ----------------------- ! … … 100 117 zdiff_hc = 0.d0 101 118 zdiff_sc = 0.d0 119 102 120 ! volume variation (calculated with ssh) 103 zdiff_v1 = SUM( surf(:,:) * tmask(:,:,1) * ( sshn(:,:) - ssh_ini(:,:) ) ) 121 zdiff_v1 = glob_sum( surf(:,:) * ( sshn(:,:) - ssh_ini(:,:) ) ) 122 123 ! heat & salt content variation (associated with ssh) 124 IF( .NOT. lk_vvl ) THEN 125 z_ssh_hc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_tem) * sshn(:,:) - ssh_hc_loc_ini(:,:) ) ) 126 z_ssh_sc = glob_sum( surf(:,:) * ( tsn(:,:,1,jp_sal) * sshn(:,:) - ssh_sc_loc_ini(:,:) ) ) 127 ENDIF 128 104 129 DO jk = 1, jpkm1 105 106 zdiff_v2 = zdiff_v2 + SUM( surf(:,:) * tmask(:,:,jk) &130 ! volume variation (calculated with scale factors) 131 zdiff_v2 = zdiff_v2 + glob_sum( surf(:,:) * tmask(:,:,jk) & 107 132 & * ( fse3t_n(:,:,jk) & 108 133 & - e3t_ini(:,:,jk) ) ) 109 134 ! heat content variation 110 zdiff_hc = zdiff_hc + SUM( surf(:,:) * tmask(:,:,jk) &135 zdiff_hc = zdiff_hc + glob_sum( surf(:,:) * tmask(:,:,jk) & 111 136 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_tem) & 112 137 & - hc_loc_ini(:,:,jk) ) ) 113 138 ! salt content variation 114 zdiff_sc = zdiff_sc + SUM( surf(:,:) * tmask(:,:,jk) &139 zdiff_sc = zdiff_sc + glob_sum( surf(:,:) * tmask(:,:,jk) & 115 140 & * ( fse3t_n(:,:,jk) * tsn(:,:,jk,jp_sal) & 116 141 & - sc_loc_ini(:,:,jk) ) ) 117 142 ENDDO 118 143 119 IF( lk_mpp ) THEN120 CALL mpp_sum( zdiff_hc )121 CALL mpp_sum( zdiff_sc )122 CALL mpp_sum( zdiff_v1 )123 CALL mpp_sum( zdiff_v2 )124 ENDIF125 126 144 ! Substract forcing from heat content, salt content and volume variations 127 145 zdiff_v1 = zdiff_v1 - frc_v 128 zdiff_v2 = zdiff_v2 - frc_v146 IF( lk_vvl ) zdiff_v2 = zdiff_v2 - frc_v 129 147 zdiff_hc = zdiff_hc - frc_t 130 148 zdiff_sc = zdiff_sc - frc_s 149 IF( .NOT. lk_vvl ) THEN 150 zdiff_hc1 = zdiff_hc + z_ssh_hc 151 zdiff_sc1 = zdiff_sc + z_ssh_sc 152 zerr_hc1 = z_ssh_hc - frc_wn_t 153 zerr_sc1 = z_ssh_sc - frc_wn_s 154 ENDIF 131 155 132 156 ! ----------------------- ! … … 134 158 ! ----------------------- ! 135 159 zdeltat = 1.e0 / ( ( kt - nit000 + 1 ) * rdt ) 136 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 137 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 138 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 139 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 160 IF( lk_vvl ) THEN 161 WRITE(numhsb , 9020) kt , zdiff_hc / vol_tot , zdiff_hc * fact1 * zdeltat, & 162 & zdiff_sc / vol_tot , zdiff_sc * fact21 * zdeltat, zdiff_sc * fact22 * zdeltat, & 163 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 164 & zdiff_v2 , zdiff_v2 * fact31 * zdeltat, zdiff_v2 * fact32 * zdeltat 165 ELSE 166 WRITE(numhsb , 9030) kt , zdiff_hc1 / vol_tot , zdiff_hc1 * fact1 * zdeltat, & 167 & zdiff_sc1 / vol_tot , zdiff_sc1 * fact21 * zdeltat, zdiff_sc1 * fact22 * zdeltat, & 168 & zdiff_v1 , zdiff_v1 * fact31 * zdeltat, zdiff_v1 * fact32 * zdeltat, & 169 & zerr_hc1 / vol_tot , zerr_sc1 / vol_tot 170 ENDIF 140 171 141 172 IF ( kt == nitend ) CLOSE( numhsb ) … … 144 175 145 176 9020 FORMAT(I5,11D15.7) 177 9030 FORMAT(I5,10D15.7) 146 178 ! 147 179 END SUBROUTINE dia_hsb … … 179 211 180 212 IF( .NOT. ln_diahsb ) RETURN 213 IF( .NOT. lk_mpp_rep ) & 214 CALL ctl_stop (' Your global mpp_sum if performed in single precision - 64 bits -', & 215 & ' whereas the global sum to be precise must be done in double precision ',& 216 & ' please add key_mpp_rep') 181 217 182 218 ! ------------------- ! 183 219 ! 1 - Allocate memory ! 184 220 ! ------------------- ! 185 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), STAT=ierror ) 221 ALLOCATE( hc_loc_ini(jpi,jpj,jpk), sc_loc_ini(jpi,jpj,jpk), & 222 & ssh_hc_loc_ini(jpi,jpj), ssh_sc_loc_ini(jpi,jpj), & 223 & e3t_ini(jpi,jpj,jpk) , & 224 & surf(jpi,jpj), ssh_ini(jpi,jpj), STAT=ierror ) 186 225 IF( ierror > 0 ) THEN 187 226 CALL ctl_stop( 'dia_hsb: unable to allocate hc_loc_ini' ) ; RETURN 188 ENDIF189 ALLOCATE( sc_loc_ini(jpi,jpj,jpk), STAT=ierror )190 IF( ierror > 0 ) THEN191 CALL ctl_stop( 'dia_hsb: unable to allocate sc_loc_ini' ) ; RETURN192 ENDIF193 ALLOCATE( e3t_ini(jpi,jpj,jpk) , STAT=ierror )194 IF( ierror > 0 ) THEN195 CALL ctl_stop( 'dia_hsb: unable to allocate e3t_ini' ) ; RETURN196 ENDIF197 ALLOCATE( surf(jpi,jpj) , STAT=ierror )198 IF( ierror > 0 ) THEN199 CALL ctl_stop( 'dia_hsb: unable to allocate surf' ) ; RETURN200 ENDIF201 ALLOCATE( ssh_ini(jpi,jpj) , STAT=ierror )202 IF( ierror > 0 ) THEN203 CALL ctl_stop( 'dia_hsb: unable to allocate ssh_ini' ) ; RETURN204 227 ENDIF 205 228 … … 214 237 cl_name = 'heat_salt_volume_budgets.txt' ! name of output file 215 238 surf(:,:) = e1t(:,:) * e2t(:,:) * tmask(:,:,1) * tmask_i(:,:) ! masked surface grid cell area 216 surf_tot = SUM( surf(:,:) ) ! total ocean surface area239 surf_tot = glob_sum( surf(:,:) ) ! total ocean surface area 217 240 vol_tot = 0.d0 ! total ocean volume 218 241 DO jk = 1, jpkm1 219 vol_tot = vol_tot + SUM( surf(:,:) * tmask(:,:,jk) &220 & * fse3t_n(:,:,jk) )242 vol_tot = vol_tot + glob_sum( surf(:,:) * tmask(:,:,jk) & 243 & * fse3t_n(:,:,jk) ) 221 244 END DO 222 IF( lk_mpp ) THEN223 CALL mpp_sum( vol_tot )224 CALL mpp_sum( surf_tot )225 ENDIF226 245 227 246 CALL ctl_opn( numhsb , cl_name , 'UNKNOWN' , 'FORMATTED' , 'SEQUENTIAL' , 1 , numout , lwp , 1 ) 228 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 229 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 230 ! 123456789012345678901234567890123456789012345 -> 45 231 & "| volume budget (ssh) ", & 232 ! 678901234567890123456789012345678901234567890 -> 45 233 & "| volume budget (e3t) " 234 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 235 & "| [m3] [mmm/s] [SV] ", & 236 & "| [m3] [mmm/s] [SV] " 237 247 IF( lk_vvl ) THEN 248 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 249 WRITE( numhsb, 9010 ) "kt | heat content budget | salt content budget ", & 250 ! 123456789012345678901234567890123456789012345 -> 45 251 & "| volume budget (ssh) ", & 252 ! 678901234567890123456789012345678901234567890 -> 45 253 & "| volume budget (e3t) " 254 WRITE( numhsb, 9010 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 255 & "| [m3] [mmm/s] [SV] ", & 256 & "| [m3] [mmm/s] [SV] " 257 ELSE 258 ! 12345678901234567890123456789012345678901234567890123456789012345678901234567890 -> 80 259 WRITE( numhsb, 9011 ) "kt | heat content budget | salt content budget ", & 260 ! 123456789012345678901234567890123456789012345 -> 45 261 & "| volume budget (ssh) ", & 262 ! 678901234567890123456789012345678901234567890 -> 45 263 & "| Non conservation due to free surface " 264 WRITE( numhsb, 9011 ) " | [C] [W/m2] | [psu] [mmm/s] [SV] ", & 265 & "| [m3] [mmm/s] [SV] ", & 266 & "| [heat - C] [salt - psu] " 267 ENDIF 238 268 ! --------------- ! 239 269 ! 3 - Conversions ! (factors will be multiplied by duration afterwards) … … 261 291 frc_t = 0.d0 ! heat content - - - - 262 292 frc_s = 0.d0 ! salt content - - - - 293 IF( .NOT. lk_vvl ) THEN 294 ssh_hc_loc_ini(:,:) = tsn(:,:,1,jp_tem) * ssh_ini(:,:) ! initial heat content associated with ssh 295 ssh_sc_loc_ini(:,:) = tsn(:,:,1,jp_sal) * ssh_ini(:,:) ! initial salt content associated with ssh 296 frc_wn_t = 0.d0 297 frc_wn_s = 0.d0 298 ENDIF 263 299 ! 264 300 9010 FORMAT(A80,A45,A45) 301 9011 FORMAT(A80,A45,A45) 265 302 ! 266 303 END SUBROUTINE dia_hsb_init -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r3865 r4258 352 352 DO jn = 1, nptr 353 353 tn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 354 sn_jk(:,:,jn) = ptr_tjk( tsn(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 354 355 END DO 355 356 ENDIF … … 565 566 !!-------------------------------------------------------------------- 566 567 ! 567 CALL wrk_alloc( jp i, zphi , zfoo )568 CALL wrk_alloc( jp i, jpk, z_1 )568 CALL wrk_alloc( jpj , zphi , zfoo ) 569 CALL wrk_alloc( jpj , jpk, z_1 ) 569 570 570 571 ! define time axis … … 880 881 ENDIF 881 882 ! 882 CALL wrk_dealloc( jp i, zphi , zfoo )883 CALL wrk_dealloc( jp i, jpk, z_1 )883 CALL wrk_dealloc( jpj , zphi , zfoo ) 884 CALL wrk_dealloc( jpj , jpk, z_1 ) 884 885 ! 885 886 END SUBROUTINE dia_ptr_wri -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/closea.F90
r3632 r4258 108 108 ncsi1(2) = 97 ; ncsj1(2) = 107 109 109 ncsi2(2) = 103 ; ncsj2(2) = 111 110 ncsir(2,1) = 110 ; ncsjr(2,1) = 111 111 ! ! Black Sea 1 : west part of the Black Sea 112 ncsnr(3) = 1 ; ncstt(3) = 2 ! (ie west of the cyclic b.c.) 113 ncsi1(3) = 174 ; ncsj1(3) = 107 ! put in Med Sea 114 ncsi2(3) = 181 ; ncsj2(3) = 112 115 ncsir(3,1) = 171 ; ncsjr(3,1) = 106 116 ! ! Black Sea 2 : est part of the Black Sea 117 ncsnr(4) = 1 ; ncstt(4) = 2 ! (ie est of the cyclic b.c.) 118 ncsi1(4) = 2 ; ncsj1(4) = 107 ! put in Med Sea 119 ncsi2(4) = 6 ; ncsj2(4) = 112 120 ncsir(4,1) = 171 ; ncsjr(4,1) = 106 110 ncsir(2,1) = 110 ; ncsjr(2,1) = 111 111 ! ! Black Sea (crossed by the cyclic boundary condition) 112 ncsnr(3:4) = 4 ; ncstt(3:4) = 2 ! put in Med Sea (north of Aegean Sea) 113 ncsir(3:4,1) = 171; ncsjr(3:4,1) = 106 ! 114 ncsir(3:4,2) = 170; ncsjr(3:4,2) = 106 115 ncsir(3:4,3) = 171; ncsjr(3:4,3) = 105 116 ncsir(3:4,4) = 170; ncsjr(3:4,4) = 105 117 ncsi1(3) = 174 ; ncsj1(3) = 107 ! 1 : west part of the Black Sea 118 ncsi2(3) = 181 ; ncsj2(3) = 112 ! (ie west of the cyclic b.c.) 119 ncsi1(4) = 2 ; ncsj1(4) = 107 ! 2 : east part of the Black Sea 120 ncsi2(4) = 6 ; ncsj2(4) = 112 ! (ie east of the cyclic b.c.) 121 122 123 121 124 ! ! ======================= 122 125 CASE ( 4 ) ! ORCA_R4 configuration … … 372 375 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: p_rnfmsk ! river runoff mask (rnfmsk array) 373 376 ! 374 INTEGER :: jc, jn ! dummy loop indices 375 INTEGER :: ii, ij ! temporary integer 377 INTEGER :: jc, jn, ji, jj ! dummy loop indices 376 378 !!---------------------------------------------------------------------- 377 379 ! … … 379 381 IF( ncstt(jc) >= 1 ) THEN ! runoff mask set to 1 at closed sea outflows 380 382 DO jn = 1, 4 381 ii = mi0( ncsir(jc,jn) ) 382 ij = mj0( ncsjr(jc,jn) ) 383 p_rnfmsk(ii,ij) = MAX( p_rnfmsk(ii,ij), 1.0_wp ) 383 DO jj = mj0( ncsjr(jc,jn) ), mj1( ncsjr(jc,jn) ) 384 DO ji = mi0( ncsir(jc,jn) ), mi1( ncsir(jc,jn) ) 385 p_rnfmsk(ji,jj) = MAX( p_rnfmsk(ji,jj), 1.0_wp ) 386 END DO 387 END DO 384 388 END DO 385 389 ENDIF -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/daymod.F90
r3851 r4258 238 238 nday_year = 1 239 239 nsec_year = ndt05 240 IF( nsec1jan000 >= 2 * (2**30 - nsecd * nyear_len(1) / 2 ) ) THEN ! test integer 4 max value 241 CALL ctl_stop( 'The number of seconds between Jan. 1st 00h of nit000 year and Jan. 1st 00h ', & 242 & 'of the current year is exceeding the INTEGER 4 max VALUE: 2^31-1 -> 68.09 years in seconds', & 243 & 'You must do a restart at higher frequency (or remove this STOP and recompile everything in I8)' ) 244 ENDIF 240 245 nsec1jan000 = nsec1jan000 + nsecd * nyear_len(1) 241 246 IF( nleapy == 1 ) CALL day_mth -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/domzgr.F90
r3865 r4258 639 639 END DO 640 640 END DO 641 IF( lk_mpp ) CALL mpp_sum( icompt ) 641 642 IF( icompt == 0 ) THEN 642 643 IF(lwp) WRITE(numout,*)' no isolated ocean grid points' … … 1252 1253 DO jj = 1, jpj 1253 1254 DO ji = 1, jpi 1254 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2 )1255 ztaper = EXP( -(gphit(ji,jj)/8._wp)**2._wp ) 1255 1256 hbatt(ji,jj) = rn_sbot_max * ztaper + hbatt(ji,jj) * ( 1._wp - ztaper ) 1256 1257 END DO … … 1375 1376 where (e3vw_0 (:,:,:).eq.0.0) e3vw_0(:,:,:) = 1.0 1376 1377 1378 #if defined key_agrif 1379 ! Ensure meaningful vertical scale factors in ghost lines/columns 1380 IF( .NOT. Agrif_Root() ) THEN 1381 ! 1382 IF((nbondi == -1).OR.(nbondi == 2)) THEN 1383 e3u_0(1,:,:) = e3u_0(2,:,:) 1384 ENDIF 1385 ! 1386 IF((nbondi == 1).OR.(nbondi == 2)) THEN 1387 e3u_0(nlci-1,:,:) = e3u_0(nlci-2,:,:) 1388 ENDIF 1389 ! 1390 IF((nbondj == -1).OR.(nbondj == 2)) THEN 1391 e3v_0(:,1,:) = e3v_0(:,2,:) 1392 ENDIF 1393 ! 1394 IF((nbondj == 1).OR.(nbondj == 2)) THEN 1395 e3v_0(:,nlcj-1,:) = e3v_0(:,nlcj-2,:) 1396 ENDIF 1397 ! 1398 ENDIF 1399 #endif 1377 1400 1378 1401 fsdept(:,:,:) = gdept_0 (:,:,:) -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90
r3765 r4258 109 109 INTEGER :: ji, jj, jk ! dummy loop indices 110 110 REAL(wp) :: z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv ! local scalars 111 REAL(wp), POINTER, DIMENSION(:,:,:) :: zub, zvb112 111 !!---------------------------------------------------------------------- 113 112 ! 114 113 IF( nn_timing == 1 ) CALL timing_start('dyn_spg_flt') 115 114 ! 116 CALL wrk_alloc( jpi,jpj,jpk, zub, zvb )117 115 ! 118 116 IF( kt == nit000 ) THEN … … 213 211 DO jk = 1, jpkm1 214 212 DO ji = 1, jpij 215 spgu(ji,1) = spgu(ji,1) + fse3u (ji,1,jk) * ua(ji,1,jk)216 spgv(ji,1) = spgv(ji,1) + fse3v (ji,1,jk) * va(ji,1,jk)213 spgu(ji,1) = spgu(ji,1) + fse3u_a(ji,1,jk) * ua(ji,1,jk) 214 spgv(ji,1) = spgv(ji,1) + fse3v_a(ji,1,jk) * va(ji,1,jk) 217 215 END DO 218 216 END DO … … 221 219 DO jj = 2, jpjm1 222 220 DO ji = 2, jpim1 223 spgu(ji,jj) = spgu(ji,jj) + fse3u (ji,jj,jk) * ua(ji,jj,jk)224 spgv(ji,jj) = spgv(ji,jj) + fse3v (ji,jj,jk) * va(ji,jj,jk)221 spgu(ji,jj) = spgu(ji,jj) + fse3u_a(ji,jj,jk) * ua(ji,jj,jk) 222 spgv(ji,jj) = spgv(ji,jj) + fse3v_a(ji,jj,jk) * va(ji,jj,jk) 225 223 END DO 226 224 END DO … … 360 358 IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' ) 361 359 ! 362 CALL wrk_dealloc( jpi,jpj,jpk, zub, zvb )363 360 ! 364 361 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_flt') -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/ICB/icb_oce.F90
r3614 r4258 37 37 USE par_oce ! ocean parameters 38 38 USE lib_mpp ! MPP library 39 USE fldread ! read input fields (FLD type)40 39 41 40 IMPLICIT NONE … … 151 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: griddata !: work array for icbrst 152 151 153 TYPE(FLD), PUBLIC, ALLOCATABLE , DIMENSION(:) :: sf_icb !: structure: file information, fields read154 155 152 !!---------------------------------------------------------------------- 156 153 !! NEMO/OPA 3.3 , NEMO Consortium (2011) … … 168 165 ! 169 166 icb_alloc = 0 170 ALLOCATE( berg_grid , & 171 & berg_grid%calving (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj) , & 167 ALLOCATE( berg_grid%calving (jpi,jpj) , berg_grid%calving_hflx (jpi,jpj) , & 172 168 & berg_grid%stored_heat(jpi,jpj) , berg_grid%floating_melt(jpi,jpj) , & 173 169 & berg_grid%maxclass (jpi,jpj) , berg_grid%stored_ice (jpi,jpj,nclasses) , & -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/ICB/icbini.F90
r3785 r4258 35 35 PUBLIC icb_init ! routine called in nemogcm.F90 module 36 36 37 CHARACTER(len=100) :: cn_dir = './' ! Root directory for location of icb files 38 TYPE(FLD_N) :: sn_icb ! information about the calving file to be read 37 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of icb files 38 TYPE(FLD_N) :: sn_icb !: information about the calving file to be read 39 TYPE(FLD), PUBLIC, ALLOCATABLE , DIMENSION(:) :: sf_icb !: structure: file information, fields read 40 !: used in icbini and icbstp 39 41 40 42 !!---------------------------------------------------------------------- -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/ICB/icbstp.F90
r3614 r4258 24 24 USE lib_mpp 25 25 USE iom 26 USE fldread 26 27 USE timing ! timing 27 28 -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/IOM/iom.F90
r3862 r4258 31 31 USE sbc_oce, ONLY : nn_fsbc ! ocean space and time domain 32 32 USE trc_oce, ONLY : nn_dttrc ! !: frequency of step on passive tracers 33 USE icb_oce, ONLY : class_num ! !: iceberg classes 33 34 USE domngb ! ocean space and time domain 34 35 USE phycst ! physical constants … … 36 37 USE xios 37 38 # endif 39 USE ioipsl, ONLY : ju2ymds ! for calendar 38 40 39 41 IMPLICIT NONE … … 52 54 PRIVATE iom_p1d, iom_p2d, iom_p3d 53 55 #if defined key_iomput 54 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_ set_grid_attr55 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring 56 PRIVATE iom_set_domain_attr, iom_set_axis_attr, iom_set_field_attr, iom_set_file_attr, iom_get_file_attr, iom_set_grid_attr 57 PRIVATE set_grid, set_scalar, set_xmlatt, set_mooring, iom_update_file_name, iom_sdate 56 58 # endif 57 59 … … 98 100 clname = "nemo" 99 101 IF( TRIM(Agrif_CFixed()) /= '0' ) clname = TRIM(Agrif_CFixed())//"_"//TRIM(clname) 102 # if defined key_mpp_mpi 100 103 CALL xios_context_initialize(TRIM(clname), mpi_comm_opa) 104 # else 105 CALL xios_context_initialize(TRIM(clname), 0) 106 # endif 101 107 CALL iom_swap 102 108 … … 123 129 CALL iom_set_axis_attr( "depthw", gdepw_1d ) 124 130 # if defined key_floats 125 CALL iom_set_axis_attr( "nfloat", ( ji, ji=1,nfloat) )131 CALL iom_set_axis_attr( "nfloat", (/ (REAL(ji,wp), ji=1,nfloat) /) ) 126 132 # endif 133 CALL iom_set_axis_attr( "icbcla", class_num ) 127 134 128 135 ! automatic definitions of some of the xml attributs … … 130 137 131 138 ! end file definition 132 dtime%second=rdt133 134 135 136 139 dtime%second = rdt 140 CALL xios_set_timestep(dtime) 141 CALL xios_close_context_definition() 142 143 CALL xios_update_calendar(0) 137 144 #endif 138 145 139 146 END SUBROUTINE iom_init 140 147 … … 174 181 LOGICAL , INTENT(in ), OPTIONAL :: ldiof ! Interp On the Fly, needed for AGRIF (default = .FALSE.) 175 182 176 CHARACTER(LEN= 100) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu]177 CHARACTER(LEN= 100) :: cltmpn ! tempory name to store clname (in writting mode)183 CHARACTER(LEN=256) :: clname ! the name of the file based on cdname [[+clcpu]+clcpu] 184 CHARACTER(LEN=256) :: cltmpn ! tempory name to store clname (in writting mode) 178 185 CHARACTER(LEN=10) :: clsuffix ! ".nc" or ".dimg" 179 186 CHARACTER(LEN=15) :: clcpu ! the cpu number (max jpmax_digits digits) 180 CHARACTER(LEN= 100) :: clinfo ! info character187 CHARACTER(LEN=256) :: clinfo ! info character 181 188 LOGICAL :: llok ! check the existence 182 189 LOGICAL :: llwrt ! local definition of ldwrt … … 561 568 REAL(wp) :: zscf, zofs ! sacle_factor and add_offset 562 569 INTEGER :: itmp ! temporary integer 563 CHARACTER(LEN= 100) :: clinfo ! info character564 CHARACTER(LEN= 100) :: clname ! file name570 CHARACTER(LEN=256) :: clinfo ! info character 571 CHARACTER(LEN=256) :: clname ! file name 565 572 CHARACTER(LEN=1) :: clrankpv, cldmspc ! 566 573 !--------------------------------------------------------------------- … … 1010 1017 !!---------------------------------------------------------------------- 1011 1018 1012 1013 1019 #if defined key_iomput 1014 1020 1015 SUBROUTINE iom_set_domain_attr( cd name, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, &1021 SUBROUTINE iom_set_domain_attr( cdid, ni_glo, nj_glo, ibegin, jbegin, ni, nj, zoom_ibegin, zoom_jbegin, zoom_ni, zoom_nj, & 1016 1022 & data_dim, data_ibegin, data_ni, data_jbegin, data_nj, lonvalue, latvalue, mask ) 1017 CHARACTER(LEN=*) , INTENT(in) :: cd name1023 CHARACTER(LEN=*) , INTENT(in) :: cdid 1018 1024 INTEGER , OPTIONAL, INTENT(in) :: ni_glo, nj_glo, ibegin, jbegin, ni, nj 1019 1025 INTEGER , OPTIONAL, INTENT(in) :: data_dim, data_ibegin, data_ni, data_jbegin, data_nj … … 1022 1028 LOGICAL, DIMENSION(:,:), OPTIONAL, INTENT(in) :: mask 1023 1029 1024 IF ( xios_is_valid_domain (cd name) ) THEN1025 CALL xios_set_domain_attr ( cd name, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &1026 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj 1027 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, 1030 IF ( xios_is_valid_domain (cdid) ) THEN 1031 CALL xios_set_domain_attr ( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1032 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1033 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1028 1034 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1029 1035 ENDIF 1030 1036 1031 IF ( xios_is_valid_domaingroup(cd name) ) THEN1032 CALL xios_set_domaingroup_attr( cd name, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, &1033 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj 1034 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, 1037 IF ( xios_is_valid_domaingroup(cdid) ) THEN 1038 CALL xios_set_domaingroup_attr( cdid, ni_glo=ni_glo, nj_glo=nj_glo, ibegin=ibegin, jbegin=jbegin, ni=ni, nj=nj, & 1039 & data_dim=data_dim, data_ibegin=data_ibegin, data_ni=data_ni, data_jbegin=data_jbegin, data_nj=data_nj , & 1040 & zoom_ibegin=zoom_ibegin, zoom_jbegin=zoom_jbegin, zoom_ni=zoom_ni, zoom_nj=zoom_nj, & 1035 1041 & lonvalue=lonvalue, latvalue=latvalue,mask=mask ) 1036 1042 ENDIF 1043 CALL xios_solve_inheritance() 1037 1044 1038 1045 END SUBROUTINE iom_set_domain_attr 1039 1046 1040 1047 1041 SUBROUTINE iom_set_axis_attr( cd name, paxis )1042 CHARACTER(LEN=*) , INTENT(in) :: cd name1048 SUBROUTINE iom_set_axis_attr( cdid, paxis ) 1049 CHARACTER(LEN=*) , INTENT(in) :: cdid 1043 1050 REAL(wp), DIMENSION(:), INTENT(in) :: paxis 1044 IF ( xios_is_valid_axis (cdname) ) CALL xios_set_axis_attr ( cdname, size=size(paxis),value=paxis ) 1045 IF ( xios_is_valid_axisgroup(cdname) ) CALL xios_set_axisgroup_attr( cdname, size=size(paxis),value=paxis ) 1051 IF ( xios_is_valid_axis (cdid) ) CALL xios_set_axis_attr ( cdid, size=size(paxis),value=paxis ) 1052 IF ( xios_is_valid_axisgroup(cdid) ) CALL xios_set_axisgroup_attr( cdid, size=size(paxis),value=paxis ) 1053 CALL xios_solve_inheritance() 1046 1054 END SUBROUTINE iom_set_axis_attr 1047 1055 1048 1056 1049 SUBROUTINE iom_set_field_attr( cd name, freq_op)1050 CHARACTER(LEN=*) , INTENT(in) :: cd name1057 SUBROUTINE iom_set_field_attr( cdid, freq_op, freq_offset ) 1058 CHARACTER(LEN=*) , INTENT(in) :: cdid 1051 1059 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_op 1052 IF ( xios_is_valid_field (cdname) ) CALL xios_set_field_attr ( cdname, freq_op=freq_op ) 1053 IF ( xios_is_valid_fieldgroup(cdname) ) CALL xios_set_fieldgroup_attr( cdname, freq_op=freq_op ) 1060 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: freq_offset 1061 IF ( xios_is_valid_field (cdid) ) CALL xios_set_field_attr ( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1062 IF ( xios_is_valid_fieldgroup(cdid) ) CALL xios_set_fieldgroup_attr( cdid, freq_op=freq_op, freq_offset=freq_offset ) 1063 CALL xios_solve_inheritance() 1054 1064 END SUBROUTINE iom_set_field_attr 1055 1065 1056 1066 1057 SUBROUTINE iom_set_file_attr( cd name, name, name_suffix )1058 CHARACTER(LEN=*) , INTENT(in) :: cd name1067 SUBROUTINE iom_set_file_attr( cdid, name, name_suffix ) 1068 CHARACTER(LEN=*) , INTENT(in) :: cdid 1059 1069 CHARACTER(LEN=*),OPTIONAL , INTENT(in) :: name, name_suffix 1060 IF ( xios_is_valid_file (cdname) ) CALL xios_set_file_attr ( cdname, name=name, name_suffix=name_suffix ) 1061 IF ( xios_is_valid_filegroup(cdname) ) CALL xios_set_filegroup_attr( cdname, name=name, name_suffix=name_suffix ) 1070 IF ( xios_is_valid_file (cdid) ) CALL xios_set_file_attr ( cdid, name=name, name_suffix=name_suffix ) 1071 IF ( xios_is_valid_filegroup(cdid) ) CALL xios_set_filegroup_attr( cdid, name=name, name_suffix=name_suffix ) 1072 CALL xios_solve_inheritance() 1062 1073 END SUBROUTINE iom_set_file_attr 1063 1074 1064 1075 1065 SUBROUTINE iom_set_grid_attr( cdname, mask ) 1066 CHARACTER(LEN=*) , INTENT(in) :: cdname 1076 SUBROUTINE iom_get_file_attr( cdid, name, name_suffix, output_freq ) 1077 CHARACTER(LEN=*) , INTENT(in ) :: cdid 1078 CHARACTER(LEN=*),OPTIONAL , INTENT(out) :: name, name_suffix, output_freq 1079 LOGICAL :: llexist1,llexist2,llexist3 1080 !--------------------------------------------------------------------- 1081 IF( PRESENT( name ) ) name = '' ! default values 1082 IF( PRESENT( name_suffix ) ) name_suffix = '' 1083 IF( PRESENT( output_freq ) ) output_freq = '' 1084 IF ( xios_is_valid_file (cdid) ) THEN 1085 CALL xios_solve_inheritance() 1086 CALL xios_is_defined_file_attr ( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1087 IF(llexist1) CALL xios_get_file_attr ( cdid, name = name ) 1088 IF(llexist2) CALL xios_get_file_attr ( cdid, name_suffix = name_suffix ) 1089 IF(llexist3) CALL xios_get_file_attr ( cdid, output_freq = output_freq ) 1090 ENDIF 1091 IF ( xios_is_valid_filegroup(cdid) ) THEN 1092 CALL xios_solve_inheritance() 1093 CALL xios_is_defined_filegroup_attr( cdid, name = llexist1, name_suffix = llexist2, output_freq = llexist3) 1094 IF(llexist1) CALL xios_get_filegroup_attr( cdid, name = name ) 1095 IF(llexist2) CALL xios_get_filegroup_attr( cdid, name_suffix = name_suffix ) 1096 IF(llexist3) CALL xios_get_filegroup_attr( cdid, output_freq = output_freq ) 1097 ENDIF 1098 END SUBROUTINE iom_get_file_attr 1099 1100 1101 SUBROUTINE iom_set_grid_attr( cdid, mask ) 1102 CHARACTER(LEN=*) , INTENT(in) :: cdid 1067 1103 LOGICAL, DIMENSION(:,:,:), OPTIONAL, INTENT(in) :: mask 1068 IF ( xios_is_valid_grid (cdname) ) CALL xios_set_grid_attr ( cdname, mask=mask ) 1069 IF ( xios_is_valid_gridgroup(cdname) ) CALL xios_set_gridgroup_attr( cdname, mask=mask ) 1104 IF ( xios_is_valid_grid (cdid) ) CALL xios_set_grid_attr ( cdid, mask=mask ) 1105 IF ( xios_is_valid_gridgroup(cdid) ) CALL xios_set_gridgroup_attr( cdid, mask=mask ) 1106 CALL xios_solve_inheritance() 1070 1107 END SUBROUTINE iom_set_grid_attr 1071 1108 … … 1073 1110 SUBROUTINE set_grid( cdgrd, plon, plat ) 1074 1111 !!---------------------------------------------------------------------- 1075 !! *** ROUTINE ***1112 !! *** ROUTINE set_grid *** 1076 1113 !! 1077 1114 !! ** Purpose : define horizontal grids … … 1101 1138 END SELECT 1102 1139 ! 1103 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = zmask(:,:,1) /= 0. )1104 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = zmask(:,:,:) /= 0. )1140 CALL iom_set_domain_attr( "grid_"//cdgrd , mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,1),(/ni,nj /)) /= 0. ) 1141 CALL iom_set_grid_attr ( "grid_"//cdgrd//"_3D", mask = RESHAPE(zmask(nldi:nlei,nldj:nlej,:),(/ni,nj,jpk/)) /= 0. ) 1105 1142 ENDIF 1106 1143 … … 1110 1147 SUBROUTINE set_scalar 1111 1148 !!---------------------------------------------------------------------- 1112 !! *** ROUTINE ***1149 !! *** ROUTINE set_scalar *** 1113 1150 !! 1114 1151 !! ** Purpose : define fake grids for scalar point … … 1126 1163 SUBROUTINE set_xmlatt 1127 1164 !!---------------------------------------------------------------------- 1128 !! *** ROUTINE ***1165 !! *** ROUTINE set_xmlatt *** 1129 1166 !! 1130 1167 !! ** Purpose : automatic definitions of some of the xml attributs... 1131 1168 !! 1132 1169 !!---------------------------------------------------------------------- 1133 CHARACTER(len=6),DIMENSION( 8) :: clsuff ! suffix name1134 1170 CHARACTER(len=1),DIMENSION( 3) :: clgrd ! suffix name 1135 CHARACTER(len= 50) :: clname ! filename1171 CHARACTER(len=256) :: clsuff ! suffix name 1136 1172 CHARACTER(len=1) :: cl1 ! 1 character 1137 1173 CHARACTER(len=2) :: cl2 ! 1 character 1138 CHARACTER(len=255) :: tfo 1139 INTEGER :: idt ! time-step in seconds 1140 INTEGER :: iddss, ihhss ! number of seconds in 1 day, 1 hour and 1 year 1141 INTEGER :: iyymo ! number of months in 1 year 1142 INTEGER :: jg, jh, jd, jm, jy ! loop counters 1174 INTEGER :: ji, jg ! loop counters 1143 1175 INTEGER :: ix, iy ! i-,j- index 1144 1176 REAL(wp) ,DIMENSION(11) :: zlontao ! longitudes of tao moorings … … 1150 1182 !!---------------------------------------------------------------------- 1151 1183 ! 1152 idt = NINT( rdttra(1) )1153 iddss = NINT( rday ) ! number of seconds in 1 day1154 ihhss = NINT( rmmss * rhhmm ) ! number of seconds in 1 hour1155 iyymo = NINT( raamo ) ! number of months in 1 year1156 1157 1184 ! frequency of the call of iom_put (attribut: freq_op) 1158 tfo = TRIM(i2str(idt))//'s' 1159 CALL iom_set_field_attr('field_definition', freq_op=tfo) 1160 CALL iom_set_field_attr('SBC' , freq_op=TRIM(i2str(idt* nn_fsbc ))//'s') 1161 CALL iom_set_field_attr('ptrc_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1162 CALL iom_set_field_attr('diad_T', freq_op=TRIM(i2str(idt* nn_dttrc))//'s') 1185 WRITE(cl1,'(i1)') 1 ; CALL iom_set_field_attr('field_definition', freq_op = cl1//'ts', freq_offset='0ts') 1186 WRITE(cl1,'(i1)') nn_fsbc ; CALL iom_set_field_attr('SBC' , freq_op = cl1//'ts', freq_offset='0ts') 1187 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('ptrc_T' , freq_op = cl1//'ts', freq_offset='0ts') 1188 WRITE(cl1,'(i1)') nn_dttrc ; CALL iom_set_field_attr('diad_T' , freq_op = cl1//'ts', freq_offset='0ts') 1163 1189 1164 1190 ! output file names (attribut: name) 1165 clsuff(:) = (/ 'grid_T', 'grid_U', 'grid_V', 'grid_W', 'icemod', 'ptrc_T', 'diad_T', 'scalar' /) 1166 DO jg = 1, SIZE(clsuff) ! grid type 1167 DO jh = 1, 24 ! 1-24 hours 1168 WRITE(cl2,'(i2)') jh 1169 CALL dia_nam( clname, jh * ihhss, clsuff(jg), ldfsec = .TRUE. ) 1170 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'h_'//clsuff(jg), name=TRIM(clname)) 1171 END DO 1172 DO jd = 1, 30 ! 1-30 days 1173 WRITE(cl1,'(i1)') jd 1174 CALL dia_nam( clname, jd * iddss, clsuff(jg), ldfsec = .TRUE. ) 1175 CALL iom_set_file_attr(cl1//'d_'//clsuff(jg), name=TRIM(clname)) 1176 END DO 1177 DO jm = 1, 11 ! 1-11 months 1178 WRITE(cl1,'(i1)') jm 1179 CALL dia_nam( clname, -jm, clsuff(jg) ) 1180 CALL iom_set_file_attr(cl1//'m_'//clsuff(jg), name=TRIM(clname)) 1181 END DO 1182 DO jy = 1, 50 ! 1-50 years 1183 WRITE(cl2,'(i2)') jy 1184 CALL dia_nam( clname, -jy * iyymo, clsuff(jg) ) 1185 CALL iom_set_file_attr(TRIM(ADJUSTL(cl2))//'y_'//clsuff(jg), name=TRIM(clname)) 1186 END DO 1191 DO ji = 1, 9 1192 WRITE(cl1,'(i1)') ji 1193 CALL iom_update_file_name('file'//cl1) 1194 END DO 1195 DO ji = 1, 99 1196 WRITE(cl2,'(i2.2)') ji 1197 CALL iom_update_file_name('file'//cl2) 1187 1198 END DO 1188 1199 … … 1193 1204 ! Equatorial section (attributs: jbegin, ni, name_suffix) 1194 1205 CALL dom_ngb( 0., 0., ix, iy, cl1 ) 1195 CALL iom_set_domain_attr('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1196 CALL iom_set_file_attr('Eq'//cl1, name_suffix= '_Eq') 1206 CALL iom_set_domain_attr ('Eq'//cl1, zoom_jbegin=iy, zoom_ni=jpiglo) 1207 CALL iom_get_file_attr ('Eq'//cl1, name_suffix = clsuff ) 1208 CALL iom_set_file_attr ('Eq'//cl1, name_suffix = TRIM(clsuff)//'_Eq') 1209 CALL iom_update_file_name('Eq'//cl1) 1197 1210 END DO 1198 1211 ! TAO moorings (attributs: ibegin, jbegin, name_suffix) … … 1214 1227 SUBROUTINE set_mooring( plon, plat) 1215 1228 !!---------------------------------------------------------------------- 1216 !! *** ROUTINE ***1229 !! *** ROUTINE set_mooring *** 1217 1230 !! 1218 1231 !! ** Purpose : automatic definitions of moorings xml attributs... … … 1223 1236 !!$ CHARACTER(len=1),DIMENSION(4) :: clgrd = (/ 'T', 'U', 'V', 'W' /) ! suffix name 1224 1237 CHARACTER(len=1),DIMENSION(1) :: clgrd = (/ 'T' /) ! suffix name 1225 CHARACTER(len=50) :: clname ! file name 1238 CHARACTER(len=256) :: clname ! file name 1239 CHARACTER(len=256) :: clsuff ! suffix name 1226 1240 CHARACTER(len=1) :: cl1 ! 1 character 1227 1241 CHARACTER(len=6) :: clon,clat ! name of longitude, latitude … … 1269 1283 ENDIF 1270 1284 clname = TRIM(ADJUSTL(clat))//TRIM(ADJUSTL(clon)) 1271 CALL iom_set_domain_attr(TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1272 CALL iom_set_file_attr(TRIM(clname)//cl1, name_suffix= '_'//TRIM(clname)) 1285 CALL iom_set_domain_attr (TRIM(clname)//cl1, zoom_ibegin= ix, zoom_jbegin= iy) 1286 CALL iom_get_file_attr (TRIM(clname)//cl1, name_suffix = clsuff ) 1287 CALL iom_set_file_attr (TRIM(clname)//cl1, name_suffix = TRIM(clsuff)//'_'//TRIM(clname)) 1288 CALL iom_update_file_name(TRIM(clname)//cl1) 1273 1289 END DO 1274 1290 END DO … … 1277 1293 END SUBROUTINE set_mooring 1278 1294 1295 1296 SUBROUTINE iom_update_file_name( cdid ) 1297 !!---------------------------------------------------------------------- 1298 !! *** ROUTINE iom_update_file_name *** 1299 !! 1300 !! ** Purpose : 1301 !! 1302 !!---------------------------------------------------------------------- 1303 CHARACTER(LEN=*) , INTENT(in) :: cdid 1304 ! 1305 CHARACTER(LEN=256) :: clname 1306 CHARACTER(LEN=20) :: clfreq 1307 CHARACTER(LEN=20) :: cldate 1308 INTEGER :: idx 1309 INTEGER :: jn 1310 INTEGER :: itrlen 1311 INTEGER :: iyear, imonth, iday, isec 1312 REAL(wp) :: zsec 1313 LOGICAL :: llexist 1314 !!---------------------------------------------------------------------- 1315 1316 DO jn = 1,2 1317 1318 IF( jn == 1 ) CALL iom_get_file_attr( cdid, name = clname, output_freq = clfreq ) 1319 IF( jn == 2 ) CALL iom_get_file_attr( cdid, name_suffix = clname ) 1320 1321 IF ( TRIM(clname) /= '' ) THEN 1322 1323 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1324 DO WHILE ( idx /= 0 ) 1325 clname = clname(1:idx-1)//TRIM(cexper)//clname(idx+9:LEN_TRIM(clname)) 1326 idx = INDEX(clname,'@expname@') + INDEX(clname,'@EXPNAME@') 1327 END DO 1328 1329 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1330 DO WHILE ( idx /= 0 ) 1331 IF ( TRIM(clfreq) /= '' ) THEN 1332 itrlen = LEN_TRIM(clfreq) 1333 IF ( clfreq(itrlen-1:itrlen) == 'mo' ) clfreq = clfreq(1:itrlen-1) 1334 clname = clname(1:idx-1)//TRIM(clfreq)//clname(idx+6:LEN_TRIM(clname)) 1335 ELSE 1336 CALL ctl_stop('error in the name of file id '//TRIM(cdid), & 1337 & ' attribute output_freq is undefined -> cannot replace @freq@ in '//TRIM(clname) ) 1338 ENDIF 1339 idx = INDEX(clname,'@freq@') + INDEX(clname,'@FREQ@') 1340 END DO 1341 1342 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1343 DO WHILE ( idx /= 0 ) 1344 cldate = iom_sdate( fjulday - rdttra(1) / rday ) 1345 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+11:LEN_TRIM(clname)) 1346 idx = INDEX(clname,'@startdate@') + INDEX(clname,'@STARTDATE@') 1347 END DO 1348 1349 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1350 DO WHILE ( idx /= 0 ) 1351 cldate = iom_sdate( fjulday - rdttra(1) / rday, ldfull = .TRUE. ) 1352 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+15:LEN_TRIM(clname)) 1353 idx = INDEX(clname,'@startdatefull@') + INDEX(clname,'@STARTDATEFULL@') 1354 END DO 1355 1356 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1357 DO WHILE ( idx /= 0 ) 1358 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE. ) 1359 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+9:LEN_TRIM(clname)) 1360 idx = INDEX(clname,'@enddate@') + INDEX(clname,'@ENDDATE@') 1361 END DO 1362 1363 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1364 DO WHILE ( idx /= 0 ) 1365 cldate = iom_sdate( fjulday + rdttra(1) / rday * REAL( nitend - nit000, wp ), ld24 = .TRUE., ldfull = .TRUE. ) 1366 clname = clname(1:idx-1)//TRIM(cldate)//clname(idx+13:LEN_TRIM(clname)) 1367 idx = INDEX(clname,'@enddatefull@') + INDEX(clname,'@ENDDATEFULL@') 1368 END DO 1369 1370 IF( jn == 1 ) CALL iom_set_file_attr( cdid, name = clname ) 1371 IF( jn == 2 ) CALL iom_set_file_attr( cdid, name_suffix = clname ) 1372 1373 ENDIF 1374 1375 END DO 1376 1377 END SUBROUTINE iom_update_file_name 1378 1379 1380 FUNCTION iom_sdate( pjday, ld24, ldfull ) 1381 !!---------------------------------------------------------------------- 1382 !! *** ROUTINE iom_sdate *** 1383 !! 1384 !! ** Purpose : send back the date corresponding to the given julian day 1385 !! 1386 !!---------------------------------------------------------------------- 1387 REAL(wp), INTENT(in ) :: pjday ! julian day 1388 LOGICAL , INTENT(in ), OPTIONAL :: ld24 ! true to force 24:00 instead of 00:00 1389 LOGICAL , INTENT(in ), OPTIONAL :: ldfull ! true to get the compleate date: yyyymmdd_hh:mm:ss 1390 ! 1391 CHARACTER(LEN=20) :: iom_sdate 1392 CHARACTER(LEN=50) :: clfmt ! format used to write the date 1393 INTEGER :: iyear, imonth, iday, ihour, iminute, isec 1394 REAL(wp) :: zsec 1395 LOGICAL :: ll24, llfull 1396 ! 1397 IF( PRESENT(ld24) ) THEN ; ll24 = ld24 1398 ELSE ; ll24 = .FALSE. 1399 ENDIF 1400 1401 IF( PRESENT(ldfull) ) THEN ; llfull = ldfull 1402 ELSE ; llfull = .FALSE. 1403 ENDIF 1404 1405 CALL ju2ymds( pjday, iyear, imonth, iday, zsec ) 1406 isec = NINT(zsec) 1407 1408 IF ( ll24 .AND. isec == 0 ) THEN ! 00:00 of the next day -> move to 24:00 of the current day 1409 CALL ju2ymds( pjday - 1., iyear, imonth, iday, zsec ) 1410 isec = 86400 1411 ENDIF 1412 1413 IF( iyear < 10000 ) THEN ; clfmt = "i4.4,2i2.2" ! format used to write the date 1414 ELSE ; WRITE(clfmt, "('i',i1,',2i2.2')") INT(LOG10(REAL(iyear,wp))) + 1 1415 ENDIF 1416 1417 IF( llfull ) THEN 1418 clfmt = TRIM(clfmt)//",'_',i2.2,':',i2.2,':',i2.2" 1419 ihour = isec / 3600 1420 isec = MOD(isec, 3600) 1421 iminute = isec / 60 1422 isec = MOD(isec, 60) 1423 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday, ihour, iminute, isec ! date of the end of run 1424 ELSE 1425 WRITE(iom_sdate, '('//TRIM(clfmt)//')') iyear, imonth, iday ! date of the end of run 1426 ENDIF 1427 1428 END FUNCTION iom_sdate 1429 1279 1430 #else 1280 1431 … … 1285 1436 1286 1437 #endif 1287 1288 FUNCTION i2str(int)1289 IMPLICIT NONE1290 INTEGER, INTENT(IN) :: int1291 CHARACTER(LEN=255) :: i2str1292 1293 WRITE(i2str,*) int1294 1295 END FUNCTION i2str1296 1438 1297 1439 !!====================================================================== -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/LBC/lbclnk.F90
r3768 r4258 283 283 END SUBROUTINE lbc_lnk_3d 284 284 285 SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy )286 !!---------------------------------------------------------------------287 !! *** ROUTINE lbc_bdy_lnk ***288 !!289 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used290 !! to maintain the same interface with regards to the mpp case291 !!292 !!----------------------------------------------------------------------293 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points294 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied295 REAL(wp) , INTENT(in ) :: psgn ! control of the sign296 INTEGER :: ib_bdy ! BDY boundary set297 !!298 CALL lbc_lnk_3d( pt3d, cd_type, psgn)299 300 END SUBROUTINE lbc_bdy_lnk_3d301 302 SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy )303 !!---------------------------------------------------------------------304 !! *** ROUTINE lbc_bdy_lnk ***305 !!306 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used307 !! to maintain the same interface with regards to the mpp case308 !!309 !!----------------------------------------------------------------------310 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points311 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied312 REAL(wp) , INTENT(in ) :: psgn ! control of the sign313 INTEGER :: ib_bdy ! BDY boundary set314 !!315 CALL lbc_lnk_2d( pt2d, cd_type, psgn)316 317 END SUBROUTINE lbc_bdy_lnk_2d318 319 285 SUBROUTINE lbc_lnk_2d( pt2d, cd_type, psgn, cd_mpp, pval ) 320 286 !!--------------------------------------------------------------------- … … 406 372 END SUBROUTINE lbc_lnk_2d 407 373 374 #endif 375 376 377 SUBROUTINE lbc_bdy_lnk_3d( pt3d, cd_type, psgn, ib_bdy ) 378 !!--------------------------------------------------------------------- 379 !! *** ROUTINE lbc_bdy_lnk *** 380 !! 381 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 382 !! to maintain the same interface with regards to the mpp 383 !case 384 !! 385 !!---------------------------------------------------------------------- 386 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 387 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pt3d ! 3D array on which the lbc is applied 388 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 389 INTEGER :: ib_bdy ! BDY boundary set 390 !! 391 CALL lbc_lnk_3d( pt3d, cd_type, psgn) 392 393 END SUBROUTINE lbc_bdy_lnk_3d 394 395 SUBROUTINE lbc_bdy_lnk_2d( pt2d, cd_type, psgn, ib_bdy ) 396 !!--------------------------------------------------------------------- 397 !! *** ROUTINE lbc_bdy_lnk *** 398 !! 399 !! ** Purpose : wrapper rountine to 'lbc_lnk_3d'. This wrapper is used 400 !! to maintain the same interface with regards to the mpp 401 !case 402 !! 403 !!---------------------------------------------------------------------- 404 CHARACTER(len=1) , INTENT(in ) :: cd_type ! nature of pt3d grid-points 405 REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pt2d ! 3D array on which the lbc is applied 406 REAL(wp) , INTENT(in ) :: psgn ! control of the sign 407 INTEGER :: ib_bdy ! BDY boundary set 408 !! 409 CALL lbc_lnk_2d( pt2d, cd_type, psgn) 410 411 END SUBROUTINE lbc_bdy_lnk_2d 412 413 408 414 SUBROUTINE lbc_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 409 415 !!--------------------------------------------------------------------- … … 430 436 END SUBROUTINE lbc_lnk_2d_e 431 437 432 # endif433 438 #endif 434 439 -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r3799 r4258 162 162 163 163 ! Arrays used in mpp_lbc_north_3d() 164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: ztab, znorthloc165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: znorthgloio166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: zfoldwk ! Workspace for message transfers avoiding mpi_allgather164 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: tab_3d, xnorthloc 165 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE, SAVE :: xnorthgloio 166 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE, SAVE :: foldwk ! Workspace for message transfers avoiding mpi_allgather 167 167 168 168 ! Arrays used in mpp_lbc_north_2d() 169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_2d, znorthloc_2d170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_2d171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: zfoldwk_2d ! Workspace for message transfers avoiding mpi_allgather169 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_2d, xnorthloc_2d 170 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_2d 171 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: foldwk_2d ! Workspace for message transfers avoiding mpi_allgather 172 172 173 173 ! Arrays used in mpp_lbc_north_e() 174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: ztab_e, znorthloc_e175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: znorthgloio_e174 REAL(wp), DIMENSION(:,:) , ALLOCATABLE, SAVE :: tab_e, xnorthloc_e 175 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: xnorthgloio_e 176 176 177 177 ! North fold arrays used to minimise the use of allgather operations. Set in nemo_northcomms (nemogcm) so need to be public … … 207 207 & t2p1(jpi,jprecj ,2) , t2p2(jpi,jprecj ,2) , & 208 208 ! 209 & ztab(jpiglo,4,jpk) , znorthloc(jpi,4,jpk) , znorthgloio(jpi,4,jpk,jpni) , &210 & zfoldwk(jpi,4,jpk) , &211 ! 212 & ztab_2d(jpiglo,4) , znorthloc_2d(jpi,4) , znorthgloio_2d(jpi,4,jpni) , &213 & zfoldwk_2d(jpi,4) , &214 ! 215 & ztab_e(jpiglo,4+2*jpr2dj) , znorthloc_e(jpi,4+2*jpr2dj) , znorthgloio_e(jpi,4+2*jpr2dj,jpni) , &209 & tab_3d(jpiglo,4,jpk) , xnorthloc(jpi,4,jpk) , xnorthgloio(jpi,4,jpk,jpni) , & 210 & foldwk(jpi,4,jpk) , & 211 ! 212 & tab_2d(jpiglo,4) , xnorthloc_2d(jpi,4) , xnorthgloio_2d(jpi,4,jpni) , & 213 & foldwk_2d(jpi,4) , & 214 ! 215 & tab_e(jpiglo,4+2*jpr2dj) , xnorthloc_e(jpi,4+2*jpr2dj) , xnorthgloio_e(jpi,4+2*jpr2dj,jpni) , & 216 216 ! 217 217 & STAT=lib_mpp_alloc ) … … 2179 2179 !!gm Remark : this is very time consumming!!! 2180 2180 ! ! ------------------------ ! 2181 IF( ijpt0 > ijpt1 .OR. iipt0 > iipt1) THEN2181 IF(((nbondi .ne. 0) .AND. (ktype .eq. 2)) .OR. ((nbondj .ne. 0) .AND. (ktype .eq. 1))) THEN 2182 2182 ! there is nothing to be migrated 2183 lmigr = .FALSE.2183 lmigr = .TRUE. 2184 2184 ELSE 2185 lmigr = . TRUE.2185 lmigr = .FALSE. 2186 2186 ENDIF 2187 2187 … … 2598 2598 ityp = -1 2599 2599 ijpjm1 = 3 2600 ztab(:,:,:) = 0.e02601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in znorthloc the last 4 jlines of pt3d2600 tab_3d(:,:,:) = 0.e0 2601 ! 2602 DO jj = nlcj - ijpj +1, nlcj ! put in xnorthloc the last 4 jlines of pt3d 2603 2603 ij = jj - nlcj + ijpj 2604 znorthloc(:,ij,:) = pt3d(:,jj,:)2604 xnorthloc(:,ij,:) = pt3d(:,jj,:) 2605 2605 END DO 2606 2606 ! 2607 ! ! Build in procs of ncomm_north the znorthgloio2607 ! ! Build in procs of ncomm_north the xnorthgloio 2608 2608 itaille = jpi * jpk * ijpj 2609 2609 IF ( l_north_nogather ) THEN … … 2615 2615 ij = jj - nlcj + ijpj 2616 2616 DO ji = 1, nlci 2617 ztab(ji+nimpp-1,ij,:) = pt3d(ji,jj,:)2617 tab_3d(ji+nimpp-1,ij,:) = pt3d(ji,jj,:) 2618 2618 END DO 2619 2619 END DO … … 2640 2640 2641 2641 DO jr = 1,nsndto(ityp) 2642 CALL mppsend(5, znorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) )2642 CALL mppsend(5, xnorthloc, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2643 2643 END DO 2644 2644 DO jr = 1,nsndto(ityp) 2645 CALL mpprecv(5, zfoldwk, itaille, isendto(jr,ityp))2645 CALL mpprecv(5, foldwk, itaille, isendto(jr,ityp)) 2646 2646 iproc = isendto(jr,ityp) + 1 2647 2647 ildi = nldit (iproc) … … 2650 2650 DO jj = 1, ijpj 2651 2651 DO ji = ildi, ilei 2652 ztab(ji+iilb-1,jj,:) = zfoldwk(ji,jj,:)2652 tab_3d(ji+iilb-1,jj,:) = foldwk(ji,jj,:) 2653 2653 END DO 2654 2654 END DO … … 2665 2665 2666 2666 IF ( ityp .lt. 0 ) THEN 2667 CALL MPI_ALLGATHER( znorthloc , itaille, MPI_DOUBLE_PRECISION, &2668 & znorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2667 CALL MPI_ALLGATHER( xnorthloc , itaille, MPI_DOUBLE_PRECISION, & 2668 & xnorthgloio, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2669 2669 ! 2670 2670 DO jr = 1, ndim_rank_north ! recover the global north array … … 2675 2675 DO jj = 1, ijpj 2676 2676 DO ji = ildi, ilei 2677 ztab(ji+iilb-1,jj,:) = znorthgloio(ji,jj,:,jr)2677 tab_3d(ji+iilb-1,jj,:) = xnorthgloio(ji,jj,:,jr) 2678 2678 END DO 2679 2679 END DO … … 2681 2681 ENDIF 2682 2682 ! 2683 ! The ztabarray has been either:2683 ! The tab_3d array has been either: 2684 2684 ! a. Fully populated by the mpi_allgather operation or 2685 2685 ! b. Had the active points for this domain and northern neighbours populated … … 2688 2688 ! this domain will be identical. 2689 2689 ! 2690 CALL lbc_nfd( ztab, cd_type, psgn ) ! North fold boundary condition2690 CALL lbc_nfd( tab_3d, cd_type, psgn ) ! North fold boundary condition 2691 2691 ! 2692 2692 DO jj = nlcj-ijpj+1, nlcj ! Scatter back to pt3d 2693 2693 ij = jj - nlcj + ijpj 2694 2694 DO ji= 1, nlci 2695 pt3d(ji,jj,:) = ztab(ji+nimpp-1,ij,:)2695 pt3d(ji,jj,:) = tab_3d(ji+nimpp-1,ij,:) 2696 2696 END DO 2697 2697 END DO … … 2730 2730 ityp = -1 2731 2731 ijpjm1 = 3 2732 ztab_2d(:,:) = 0.e02733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in znorthloc_2d the last 4 jlines of pt2d2732 tab_2d(:,:) = 0.e0 2733 ! 2734 DO jj = nlcj-ijpj+1, nlcj ! put in xnorthloc_2d the last 4 jlines of pt2d 2735 2735 ij = jj - nlcj + ijpj 2736 znorthloc_2d(:,ij) = pt2d(:,jj)2736 xnorthloc_2d(:,ij) = pt2d(:,jj) 2737 2737 END DO 2738 2738 2739 ! ! Build in procs of ncomm_north the znorthgloio_2d2739 ! ! Build in procs of ncomm_north the xnorthgloio_2d 2740 2740 itaille = jpi * ijpj 2741 2741 IF ( l_north_nogather ) THEN … … 2747 2747 ij = jj - nlcj + ijpj 2748 2748 DO ji = 1, nlci 2749 ztab_2d(ji+nimpp-1,ij) = pt2d(ji,jj)2749 tab_2d(ji+nimpp-1,ij) = pt2d(ji,jj) 2750 2750 END DO 2751 2751 END DO … … 2773 2773 2774 2774 DO jr = 1,nsndto(ityp) 2775 CALL mppsend(5, znorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) )2775 CALL mppsend(5, xnorthloc_2d, itaille, isendto(jr,ityp), ml_req_nf(jr) ) 2776 2776 END DO 2777 2777 DO jr = 1,nsndto(ityp) 2778 CALL mpprecv(5, zfoldwk_2d, itaille, isendto(jr,ityp))2778 CALL mpprecv(5, foldwk_2d, itaille, isendto(jr,ityp)) 2779 2779 iproc = isendto(jr,ityp) + 1 2780 2780 ildi = nldit (iproc) … … 2783 2783 DO jj = 1, ijpj 2784 2784 DO ji = ildi, ilei 2785 ztab_2d(ji+iilb-1,jj) = zfoldwk_2d(ji,jj)2785 tab_2d(ji+iilb-1,jj) = foldwk_2d(ji,jj) 2786 2786 END DO 2787 2787 END DO … … 2798 2798 2799 2799 IF ( ityp .lt. 0 ) THEN 2800 CALL MPI_ALLGATHER( znorthloc_2d , itaille, MPI_DOUBLE_PRECISION, &2801 & znorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2800 CALL MPI_ALLGATHER( xnorthloc_2d , itaille, MPI_DOUBLE_PRECISION, & 2801 & xnorthgloio_2d, itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2802 2802 ! 2803 2803 DO jr = 1, ndim_rank_north ! recover the global north array … … 2808 2808 DO jj = 1, ijpj 2809 2809 DO ji = ildi, ilei 2810 ztab_2d(ji+iilb-1,jj) = znorthgloio_2d(ji,jj,jr)2810 tab_2d(ji+iilb-1,jj) = xnorthgloio_2d(ji,jj,jr) 2811 2811 END DO 2812 2812 END DO … … 2814 2814 ENDIF 2815 2815 ! 2816 ! The ztab array has been either:2816 ! The tab array has been either: 2817 2817 ! a. Fully populated by the mpi_allgather operation or 2818 2818 ! b. Had the active points for this domain and northern neighbours populated … … 2821 2821 ! this domain will be identical. 2822 2822 ! 2823 CALL lbc_nfd( ztab_2d, cd_type, psgn ) ! North fold boundary condition2823 CALL lbc_nfd( tab_2d, cd_type, psgn ) ! North fold boundary condition 2824 2824 ! 2825 2825 ! … … 2827 2827 ij = jj - nlcj + ijpj 2828 2828 DO ji = 1, nlci 2829 pt2d(ji,jj) = ztab_2d(ji+nimpp-1,ij)2829 pt2d(ji,jj) = tab_2d(ji+nimpp-1,ij) 2830 2830 END DO 2831 2831 END DO … … 2860 2860 ! 2861 2861 ijpj=4 2862 ztab_e(:,:) = 0.e02862 tab_e(:,:) = 0.e0 2863 2863 2864 2864 ij=0 2865 ! put in znorthloc_e the last 4 jlines of pt2d2865 ! put in xnorthloc_e the last 4 jlines of pt2d 2866 2866 DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 2867 2867 ij = ij + 1 2868 2868 DO ji = 1, jpi 2869 znorthloc_e(ji,ij)=pt2d(ji,jj)2869 xnorthloc_e(ji,ij)=pt2d(ji,jj) 2870 2870 END DO 2871 2871 END DO 2872 2872 ! 2873 2873 itaille = jpi * ( ijpj + 2 * jpr2dj ) 2874 CALL MPI_ALLGATHER( znorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, &2875 & znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr )2874 CALL MPI_ALLGATHER( xnorthloc_e(1,1) , itaille, MPI_DOUBLE_PRECISION, & 2875 & xnorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 2876 2876 ! 2877 2877 DO jr = 1, ndim_rank_north ! recover the global north array … … 2882 2882 DO jj = 1, ijpj+2*jpr2dj 2883 2883 DO ji = ildi, ilei 2884 ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr)2884 tab_e(ji+iilb-1,jj) = xnorthgloio_e(ji,jj,jr) 2885 2885 END DO 2886 2886 END DO … … 2890 2890 ! 2. North-Fold boundary conditions 2891 2891 ! ---------------------------------- 2892 CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj )2892 CALL lbc_nfd( tab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 2893 2893 2894 2894 ij = jpr2dj … … 2897 2897 ij = ij +1 2898 2898 DO ji= 1, nlci 2899 pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij)2899 pt2d(ji,jj) = tab_e(ji+nimpp-1,ij) 2900 2900 END DO 2901 2901 END DO -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90
r3818 r4258 122 122 irestj = 1 + MOD( jpjglo - nrecj -1 , jpnj ) 123 123 124 #if defined key_nemocice_decomp 125 ! Change padding to be consistent with CICE 126 ilci(1:jpni-1 ,:) = jpi 127 ilci(jpni ,:) = jpiglo - (jpni - 1) * (jpi - nreci) 128 129 ilcj(:, 1:jpnj-1) = jpj 130 ilcj(:, jpnj) = jpjglo - (jpnj - 1) * (jpj - nrecj) 131 #else 124 132 ilci(1:iresti ,:) = jpi 125 133 ilci(iresti+1:jpni ,:) = jpi-1 … … 127 135 ilcj(:, 1:irestj) = jpj 128 136 ilcj(:, irestj+1:jpnj) = jpj-1 137 #endif 129 138 130 139 IF(lwp) WRITE(numout,*) -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/SBC/geo2ocean.F90
r2715 r4258 187 187 & gsinf(jpi,jpj), gcosf(jpi,jpj), STAT=ierr ) 188 188 IF(lk_mpp) CALL mpp_sum( ierr ) 189 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )189 IF( ierr /= 0 ) CALL ctl_stop('angle: unable to allocate arrays' ) 190 190 191 191 ! ============================= ! … … 361 361 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 362 362 IF( lk_mpp ) CALL mpp_sum( ierr ) 363 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )363 IF( ierr /= 0 ) CALL ctl_stop('geo2oce: unable to allocate arrays' ) 364 364 ENDIF 365 365 … … 438 438 !!---------------------------------------------------------------------- 439 439 440 IF( ALLOCATED( gsinlon ) ) THEN440 IF( .NOT. ALLOCATED( gsinlon ) ) THEN 441 441 ALLOCATE( gsinlon(jpi,jpj,4) , gcoslon(jpi,jpj,4) , & 442 442 & gsinlat(jpi,jpj,4) , gcoslat(jpi,jpj,4) , STAT=ierr ) 443 443 IF( lk_mpp ) CALL mpp_sum( ierr ) 444 IF( ierr /= 0 ) CALL ctl_stop(' STOP', 'angle_msh_geo: unable to allocate arrays' )444 IF( ierr /= 0 ) CALL ctl_stop('oce2geo: unable to allocate arrays' ) 445 445 ENDIF 446 446 -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_oce.F90
r3865 r4258 70 70 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: sfx , sfx_b !: salt flux [PSU/m2/s] 71 71 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: emp_tot !: total E-P over ocean and ice [Kg/m2/s] 72 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: fmmflx !: freshwater budget: freezing/melting [Kg/m2/s] 72 73 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: rnf , rnf_b !: river runoff [Kg/m2/s] 73 74 !! … … 116 117 & qsr_tot(jpi,jpj) , qsr (jpi,jpj) , & 117 118 & emp (jpi,jpj) , emp_b(jpi,jpj) , & 118 & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj) 119 & sfx (jpi,jpj) , sfx_b(jpi,jpj) , emp_tot(jpi,jpj), fmmflx(jpi,jpj), STAT=ierr(2) ) 119 120 ! 120 121 ALLOCATE( rnf (jpi,jpj) , sbc_tsc (jpi,jpj,jpts) , qsr_hc (jpi,jpj,jpk) , & -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r3680 r4258 407 407 SELECT CASE( TRIM( sn_rcv_emp%cldes ) ) 408 408 CASE( 'oce only' ) ; srcv( jpr_oemp )%laction = .TRUE. 409 CASE( 'conservative' ) ; srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 409 CASE( 'conservative' ) 410 srcv( (/jpr_rain, jpr_snow, jpr_ievp, jpr_tevp/) )%laction = .TRUE. 411 IF ( k_ice <= 1 ) srcv(jpr_ivep)%laction = .FALSE. 410 412 CASE( 'oce and ice' ) ; srcv( (/jpr_ievp, jpr_sbpr, jpr_semp, jpr_oemp/) )%laction = .TRUE. 411 413 CASE default ; CALL ctl_stop( 'sbc_cpl_init: wrong definition of sn_rcv_emp%cldes' ) … … 465 467 CALL ctl_stop( 'sbc_cpl_init: namsbc_cpl namelist mismatch between sn_rcv_qns%cldes and sn_rcv_dqnsdt%cldes' ) 466 468 ! ! ------------------------- ! 467 ! ! Ice Qsr penetration !468 ! ! ------------------------- !469 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer470 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 )471 ! Coupled case: since cloud cover is not received from atmosphere472 ! ===> defined as constant value -> definition done in sbc_cpl_init473 fr1_i0(:,:) = 0.18474 fr2_i0(:,:) = 0.82475 ! ! ------------------------- !476 469 ! ! 10m wind module ! 477 470 ! ! ------------------------- ! … … 508 501 ! Allocate taum part of frcv which is used even when not received as coupling field 509 502 IF ( .NOT. srcv(jpr_taum)%laction ) ALLOCATE( frcv(jpr_taum)%z3(jpi,jpj,srcv(jn)%nct) ) 503 ! Allocate itx1 and ity1 as they are used in sbc_cpl_ice_tau even if srcv(jpr_itx1)%laction = .FALSE. 504 IF( k_ice /= 0 ) THEN 505 IF ( .NOT. srcv(jpr_itx1)%laction ) ALLOCATE( frcv(jpr_itx1)%z3(jpi,jpj,srcv(jn)%nct) ) 506 IF ( .NOT. srcv(jpr_ity1)%laction ) ALLOCATE( frcv(jpr_ity1)%z3(jpi,jpj,srcv(jn)%nct) ) 507 END IF 510 508 511 509 ! ================================ ! … … 911 909 !! third as 2 components on the cp_ice_msh point 912 910 !! 913 !! In 'oce and ice' case, only one vector stress field911 !! Except in 'oce and ice' case, only one vector stress field 914 912 !! is received. It has already been processed in sbc_cpl_rcv 915 913 !! so that it is now defined as (i,j) components given at U- 916 !! and V-points, respectively. Therefore, hereonly the third914 !! and V-points, respectively. Therefore, only the third 917 915 !! transformation is done and only if the ice-grid is a 'I'-grid. 918 916 !! … … 1329 1327 END SELECT 1330 1328 1329 ! Ice Qsr penetration used (only?)in lim2 or lim3 1330 ! fraction of net shortwave radiation which is not absorbed in the thin surface layer 1331 ! and penetrates inside the ice cover ( Maykut and Untersteiner, 1971 ; Elbert anbd Curry, 1993 ) 1332 ! Coupled case: since cloud cover is not received from atmosphere 1333 ! ===> defined as constant value -> definition done in sbc_cpl_init 1334 fr1_i0(:,:) = 0.18 1335 fr2_i0(:,:) = 0.82 1336 1337 1331 1338 CALL wrk_dealloc( jpi,jpj, zcptn, ztmp, zicefr ) 1332 1339 ! -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/SBC/sbcmod.F90
r3764 r4258 146 146 sfx(:,:) = 0.0_wp ! the salt flux due to freezing/melting will be computed (i.e. will be non-zero) 147 147 ! only if sea-ice is present 148 149 fmmflx(:,:) = 0.0_wp ! freezing-melting array initialisation 148 150 149 151 ! ! restartability … … 218 220 IF( nsbc == 6 ) WRITE(numout,*) ' MFS Bulk formulation' 219 221 ENDIF 222 ! 223 CALL sbc_ssm_init ! Sea-surface mean fields initialisation 220 224 ! 221 225 IF( ln_ssr ) CALL sbc_ssr_init ! Sea-Surface Restoring initialisation … … 362 366 ! (includes virtual salt flux beneath ice 363 367 ! in linear free surface case) 368 CALL iom_put( "fmmflx", fmmflx ) ! Freezing-melting water flux 364 369 CALL iom_put( "qt" , qns + qsr ) ! total heat flux 365 370 CALL iom_put( "qns" , qns ) ! solar heat flux -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/SOL/solmat.F90
r3609 r4258 30 30 USE lbclnk ! lateral boudary conditions 31 31 USE lib_mpp ! distributed memory computing 32 USE c1d ! 1D vertical configuration 32 33 USE in_out_manager ! I/O manager 33 34 USE timing ! timing … … 271 272 272 273 ! SOR and PCG solvers 274 IF( lk_c1d ) CALL lbc_lnk( gcdmat, 'T', 1._wp ) ! 1D case bmask =/0 but gcdmat not define everywhere 273 275 DO jj = 1, jpj 274 276 DO ji = 1, jpi -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r3865 r4258 677 677 678 678 679 FUNCTION tfreez( psal ) RESULT( ptf )679 FUNCTION tfreez( psal, pdep ) RESULT( ptf ) 680 680 !!---------------------------------------------------------------------- 681 681 !! *** ROUTINE eos_init *** … … 690 690 !!---------------------------------------------------------------------- 691 691 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: psal ! salinity [psu] 692 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ), OPTIONAL :: pdep ! depth [decibars] 692 693 ! Leave result array automatic rather than making explicitly allocated 693 694 REAL(wp), DIMENSION(jpi,jpj) :: ptf ! freezing temperature [Celcius] … … 696 697 ptf(:,:) = ( - 0.0575_wp + 1.710523e-3_wp * SQRT( psal(:,:) ) & 697 698 & - 2.154996e-4_wp * psal(:,:) ) * psal(:,:) 699 IF ( PRESENT( pdep ) ) THEN 700 ptf(:,:) = ptf(:,:) - 7.53e-4_wp * pdep(:,:) 701 ENDIF 698 702 ! 699 703 END FUNCTION tfreez -
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/step.F90
r4246 r4258 314 314 ! 315 315 #if defined key_iomput 316 IF( kstp == nitend 316 IF( kstp == nitend .OR. indic < 0 ) CALL xios_context_finalize() ! needed for XIOS+AGRIF 317 317 #endif 318 318 !
Note: See TracChangeset
for help on using the changeset viewer.
