Changeset 5407 for trunk/NEMOGCM/NEMO/SAS_SRC
- Timestamp:
- 2015-06-11T21:13:22+02:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/SAS_SRC
- Files:
-
- 4 edited
-
daymod.F90 (modified) (1 diff)
-
nemogcm.F90 (modified) (19 diffs)
-
sbcssm.F90 (modified) (11 diffs)
-
step.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/SAS_SRC/daymod.F90
r5215 r5407 131 131 132 132 ! control print 133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i 6)')' ==============>> 1/2 time step before the start of the run DATE Y/M/D = ', &133 IF(lwp) WRITE(numout,'(a,i6,a,i2,a,i2,a,i8,a,i8)')' =======>> 1/2 time step before the start of the run DATE Y/M/D = ', & 134 134 & nyear, '/', nmonth, '/', nday, ' nsec_day:', nsec_day, ' nsec_week:', nsec_week 135 135 -
trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r5215 r5407 42 42 USE step_oce ! module used in the ocean time stepping module 43 43 USE sbc_oce ! surface boundary condition: ocean 44 USE cla ! cross land advection (tra_cla routine)45 44 USE domcfg ! domain configuration (dom_cfg routine) 46 45 USE daymod ! calendar … … 50 49 USE step ! NEMO time-stepping (stp routine) 51 50 USE lib_mpp ! distributed memory computing 51 #if defined key_nosignedzero 52 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 53 #endif 52 54 #if defined key_iomput 53 55 USE xios 54 56 #endif 57 USE cpl_oasis3 55 58 USE sbcssm 56 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 59 USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges 60 USE icbstp ! handle bergs, calving, themodynamics and transport 57 61 58 62 IMPLICIT NONE … … 96 100 ! !-----------------------! 97 101 #if defined key_agrif 98 CALL Agrif_Declare_Var ! AGRIF: set the meshes 102 CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM 103 CALL Agrif_Declare_Var ! " " " " " DYN/TRA 104 # if defined key_top 105 CALL Agrif_Declare_Var_top ! " " " " " TOP 106 # endif 107 # if defined key_lim2 108 CALL Agrif_Declare_Var_lim2 ! " " " " " LIM 109 # endif 99 110 #endif 100 111 ! check that all process are still there... If some process have an error, … … 118 129 IF( lk_mpp ) CALL mpp_max( nstop ) 119 130 END DO 131 ! 132 IF( ln_icebergs ) CALL icb_end( nitend ) 133 120 134 ! !------------------------! 121 135 ! !== finalize the run ==! … … 136 150 ! 137 151 CALL nemo_closefile 152 ! 138 153 #if defined key_iomput 139 154 CALL xios_finalize ! end mpp communications with xios 155 IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS 140 156 #else 141 IF( lk_mpp ) CALL mppstop ! end mpp communications 157 IF( lk_oasis ) THEN 158 CALL cpl_finalize ! end coupling and mpp communications with OASIS 159 ELSE 160 IF( lk_mpp ) CALL mppstop ! end mpp communications 161 ENDIF 142 162 #endif 143 163 ! … … 154 174 INTEGER :: ilocal_comm ! local integer 155 175 INTEGER :: ios 156 157 176 CHARACTER(len=80), DIMENSION(16) :: cltxt 158 !! 177 CHARACTER(len=80) :: clname 178 ! 159 179 NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, & 160 180 & nn_isplt, nn_jsplt, nn_jctls, nn_jctle, & … … 163 183 & jpizoom, jpjzoom, jperio, ln_use_jattr 164 184 !!---------------------------------------------------------------------- 185 ! 165 186 cltxt = '' 166 187 ! 167 188 ! ! Open reference namelist and configuration namelist files 168 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 169 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 189 IF( lk_oasis ) THEN 190 CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 191 CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 192 cxios_context = 'sas' 193 clname = 'output.namelist_sas.dyn' 194 ELSE 195 CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 196 CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. ) 197 cxios_context = 'nemo' 198 clname = 'output.namelist.dyn' 199 ENDIF 170 200 ! 171 201 REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints & Benchmark … … 186 216 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. ) 187 217 218 ! Force values for AGRIF zoom (cf. agrif_user.F90) 219 #if defined key_agrif 220 IF( .NOT. Agrif_Root() ) THEN 221 jpiglo = nbcellsx + 2 + 2*nbghostcells 222 jpjglo = nbcellsy + 2 + 2*nbghostcells 223 jpi = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 224 jpj = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 225 jpidta = jpiglo 226 jpjdta = jpjglo 227 jpizoom = 1 228 jpjzoom = 1 229 nperio = 0 230 jperio = 0 231 ln_use_jattr = .false. 232 ENDIF 233 #endif 234 ! 188 235 ! !--------------------------------------------! 189 236 ! ! set communicator & select the local node ! … … 193 240 #if defined key_iomput 194 241 IF( Agrif_Root() ) THEN 195 CALL xios_initialize( "nemo",return_comm=ilocal_comm ) 196 ENDIF 197 narea = mynode ( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 242 IF( lk_oasis ) THEN 243 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 244 CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios 245 ELSE 246 CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios 247 ENDIF 248 ENDIF 249 narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection 198 250 #else 199 ilocal_comm = 0 200 narea = mynode( cltxt, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 251 IF( lk_oasis ) THEN 252 IF( Agrif_Root() ) THEN 253 CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis 254 ENDIF 255 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt) 256 ELSE 257 ilocal_comm = 0 258 narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt) 259 ENDIF 201 260 #endif 202 261 narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 ) … … 229 288 ! than variables 230 289 IF( Agrif_Root() ) THEN 290 #if defined key_nemocice_decomp 291 jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 292 jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 293 #else 231 294 jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first dim. 232 #if defined key_nemocice_decomp233 jpj = ( jpjglo+1-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.234 #else235 295 jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim. 236 296 #endif 297 ENDIF 237 298 jpk = jpkdta ! third dim 238 299 jpim1 = jpi-1 ! inner domain indices … … 240 301 jpkm1 = jpk-1 ! " " 241 302 jpij = jpi*jpj ! jpi x j 242 ENDIF243 303 244 304 IF(lwp) THEN ! open listing units 245 305 ! 246 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 306 IF( lk_oasis ) THEN 307 CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 308 ELSE 309 CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 310 ENDIF 247 311 ! 248 312 WRITE(numout,*) … … 287 351 288 352 IF( ln_ctl ) CALL prt_ctl_init ! Print control 289 CALL flush(numout)290 291 353 CALL day_init ! model calendar (using both namelist and restart infos) 292 354 … … 397 459 ENDIF 398 460 ! 461 IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', & 462 & 'f2003 standard. ' , & 463 & 'Compile with key_nosignedzero enabled' ) 464 ! 399 465 END SUBROUTINE nemo_ctl 400 466 … … 438 504 USE oce , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass 439 505 ! 440 INTEGER :: ierr,ierr4 506 INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6 507 INTEGER :: jpm 441 508 !!---------------------------------------------------------------------- 442 509 ! … … 444 511 ierr = ierr + dom_oce_alloc () ! ocean domain 445 512 ALLOCATE( snwice_mass(jpi,jpj) , snwice_mass_b(jpi,jpj), & 446 & snwice_fmass(jpi,jpj), STAT= ierr4 ) 447 ierr = ierr + ierr4 513 & snwice_fmass(jpi,jpj), STAT= ierr1 ) 514 ! 515 ! lim code currently uses surface temperature and salinity in tsn array for initialisation 516 ! and ub, vb arrays in ice dynamics 517 ! so allocate enough of arrays to use 518 ! 519 jpm = MAX(jp_tem, jp_sal) 520 ALLOCATE( tsn(jpi,jpj,1,jpm) , STAT=ierr2 ) 521 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr3 ) 522 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr4 ) 523 ALLOCATE( tsb(jpi,jpj,1,jpm) , STAT=ierr5 ) 524 ALLOCATE( sshn(jpi,jpj) , STAT=ierr6 ) 525 526 ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 448 527 ! 449 528 IF( lk_mpp ) CALL mpp_sum( ierr ) … … 470 549 INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors 471 550 !!---------------------------------------------------------------------- 472 551 ! 473 552 ierr = 0 474 553 ! 475 554 CALL factorise( ifact, nfactmax, nfact, num_pes, ierr ) 476 555 ! 477 556 IF( nfact <= 1 ) THEN 478 557 WRITE (numout, *) 'WARNING: factorisation of number of PEs failed' … … 516 595 INTEGER, PARAMETER :: ntest = 14 517 596 INTEGER :: ilfax(ntest) 518 597 ! 519 598 ! lfax contains the set of allowed factors. 520 599 data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256, & … … 601 680 !loop over the other north-fold processes to find the processes 602 681 !managing the points belonging to the sxT-dxT range 603 DO jn = jpnij - jpni +1, jpnij604 IF ( njmppt(jn) == njmppmax ) THEN682 683 DO jn = 1, jpni 605 684 !sxT is the first point (in the global domain) of the jn 606 685 !process 607 sxT = n imppt(jn)686 sxT = nfiimpp(jn, jpnj) 608 687 !dxT is the last point (in the global domain) of the jn 609 688 !process 610 dxT = n imppt(jn) + nlcit(jn) - 1689 dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 611 690 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 612 691 nsndto = nsndto + 1 613 isendto(nsndto) = jn614 ELSEIF ((sxM .le. sxT) .AND. (dxM .g t. dxT)) THEN692 isendto(nsndto) = jn 693 ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 615 694 nsndto = nsndto + 1 616 695 isendto(nsndto) = jn … … 619 698 isendto(nsndto) = jn 620 699 END IF 621 END IF622 700 END DO 701 nfsloop = 1 702 nfeloop = nlci 703 DO jn = 2,jpni-1 704 IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 705 IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 706 nfsloop = nldi 707 ENDIF 708 IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 709 nfeloop = nlei 710 ENDIF 711 ENDIF 712 END DO 713 623 714 ENDIF 624 715 l_north_nogather = .TRUE. -
trunk/NEMOGCM/NEMO/SAS_SRC/sbcssm.F90
r5215 r5407 36 36 PUBLIC sbc_ssm ! called by sbc 37 37 38 CHARACTER(len=100) :: cn_dir = './' !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uv = .true. !: specify whether input velocity data is 3D 40 INTEGER , SAVE :: nfld_3d 41 INTEGER , SAVE :: nfld_2d 42 43 INTEGER , PARAMETER :: jpfld_3d = 4 ! maximum number of files to read 44 INTEGER , PARAMETER :: jpfld_2d = 1 ! maximum number of files to read 45 INTEGER , SAVE :: jf_tem ! index of temperature 46 INTEGER , SAVE :: jf_sal ! index of salinity 47 INTEGER , SAVE :: jf_usp ! index of u velocity component 48 INTEGER , SAVE :: jf_vsp ! index of v velocity component 49 INTEGER , SAVE :: jf_ssh ! index of sea surface height 38 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssm files 39 LOGICAL :: ln_3d_uve !: specify whether input velocity data is 3D 40 LOGICAL :: ln_read_frq !: specify whether we must read frq or not 41 LOGICAL :: l_initdone = .false. 42 INTEGER :: nfld_3d 43 INTEGER :: nfld_2d 44 45 INTEGER :: jf_tem ! index of temperature 46 INTEGER :: jf_sal ! index of salinity 47 INTEGER :: jf_usp ! index of u velocity component 48 INTEGER :: jf_vsp ! index of v velocity component 49 INTEGER :: jf_ssh ! index of sea surface height 50 INTEGER :: jf_e3t ! index of first T level thickness 51 INTEGER :: jf_frq ! index of fraction of qsr absorbed in the 1st T level 50 52 51 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_3d ! structure of input fields (file information, fields read) 52 54 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ssm_2d ! structure of input fields (file information, fields read) 53 55 54 !! * Substitutions55 # include "domzgr_substitute.h90"56 # include "vectopt_loop_substitute.h90"57 56 !!---------------------------------------------------------------------- 58 57 !! NEMO/OFF 3.3 , NEMO Consortium (2010) … … 86 85 IF( nfld_2d > 0 ) CALL fld_read( kt, 1, sf_ssm_2d ) !== read data at kt time step ==! 87 86 ! 88 IF( ln_3d_uv ) THEN87 IF( ln_3d_uve ) THEN 89 88 ssu_m(:,:) = sf_ssm_3d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 90 89 ssv_m(:,:) = sf_ssm_3d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 90 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_3d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 91 91 ELSE 92 92 ssu_m(:,:) = sf_ssm_2d(jf_usp)%fnow(:,:,1) * umask(:,:,1) ! u-velocity 93 93 ssv_m(:,:) = sf_ssm_2d(jf_vsp)%fnow(:,:,1) * vmask(:,:,1) ! v-velocity 94 IF( lk_vvl ) e3t_m(:,:) = sf_ssm_2d(jf_e3t)%fnow(:,:,1) * tmask(:,:,1) ! v-velocity 94 95 ENDIF 95 96 ! … … 97 98 sss_m(:,:) = sf_ssm_2d(jf_sal)%fnow(:,:,1) * tmask(:,:,1) ! salinity 98 99 ssh_m(:,:) = sf_ssm_2d(jf_ssh)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 99 ! 100 tsn(:,:,1,jp_tem) = sst_m(:,:) 101 tsn(:,:,1,jp_sal) = sss_m(:,:) 100 IF( ln_read_frq ) frq_m(:,:) = sf_ssm_2d(jf_frq)%fnow(:,:,1) * tmask(:,:,1) ! sea surface height 101 ! 102 102 IF ( nn_ice == 1 ) THEN 103 tsn(:,:,1,jp_tem) = sst_m(:,:) 104 tsn(:,:,1,jp_sal) = sss_m(:,:) 103 105 tsb(:,:,1,jp_tem) = sst_m(:,:) 104 106 tsb(:,:,1,jp_sal) = sss_m(:,:) 105 107 ENDIF 106 ub (:,:,1 107 vb (:,:,1 108 ub (:,:,1) = ssu_m(:,:) 109 vb (:,:,1) = ssv_m(:,:) 108 110 109 111 IF(ln_ctl) THEN ! print control … … 113 115 CALL prt_ctl(tab2d_1=ssv_m, clinfo1=' ssv_m - : ', mask1=vmask, ovlap=1 ) 114 116 CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' ssh_m - : ', mask1=tmask, ovlap=1 ) 117 IF( lk_vvl ) CALL prt_ctl(tab2d_1=ssh_m, clinfo1=' e3t_m - : ', mask1=tmask, ovlap=1 ) 118 IF( ln_read_frq ) CALL prt_ctl(tab2d_1=frq_m, clinfo1=' frq_m - : ', mask1=tmask, ovlap=1 ) 119 ENDIF 120 ! 121 IF( l_initdone ) THEN ! Mean value at each nn_fsbc time-step ! 122 CALL iom_put( 'ssu_m', ssu_m ) 123 CALL iom_put( 'ssv_m', ssv_m ) 124 CALL iom_put( 'sst_m', sst_m ) 125 CALL iom_put( 'sss_m', sss_m ) 126 CALL iom_put( 'ssh_m', ssh_m ) 127 IF( lk_vvl ) CALL iom_put( 'e3t_m', e3t_m ) 128 IF( ln_read_frq ) CALL iom_put( 'frq_m', frq_m ) 115 129 ENDIF 116 130 ! … … 138 152 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_2d ! array of namelist information on the fields to read 139 153 TYPE(FLD_N) :: sn_tem, sn_sal ! information about the fields to be read 140 TYPE(FLD_N) :: sn_usp, sn_vsp, sn_ssh 141 ! 142 NAMELIST/namsbc_sas/cn_dir, ln_3d_uv, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh 143 !!---------------------------------------------------------------------- 154 TYPE(FLD_N) :: sn_usp, sn_vsp 155 TYPE(FLD_N) :: sn_ssh, sn_e3t, sn_frq 156 ! 157 NAMELIST/namsbc_sas/cn_dir, ln_3d_uve, ln_read_frq, sn_tem, sn_sal, sn_usp, sn_vsp, sn_ssh, sn_e3t, sn_frq 158 !!---------------------------------------------------------------------- 159 160 IF( ln_rstart .AND. nn_components == jp_iam_sas ) RETURN 144 161 145 162 REWIND( numnam_ref ) ! Namelist namsbc_sas in reference namelist : Input fields … … 159 176 WRITE(numout,*) '~~~~~~~~~~~ ' 160 177 WRITE(numout,*) ' Namelist namsbc_sas' 178 WRITE(numout,*) ' Are we supplying a 3D u,v and e3 field ln_3d_uve = ', ln_3d_uve 179 WRITE(numout,*) ' Are we reading frq (fraction of qsr absorbed in the 1st T level) ln_read_frq = ', ln_read_frq 161 180 WRITE(numout,*) 162 181 ENDIF 163 164 182 ! 165 183 !! switch off stuff that isn't sensible with a standalone module … … 170 188 ln_apr_dyn = .FALSE. 171 189 ENDIF 172 IF( ln_dm2dc ) THEN173 IF( lwp ) WRITE(numout,*) 'No diurnal cycle needed with StandAlone Surface scheme'174 ln_dm2dc = .FALSE.175 ENDIF176 190 IF( ln_rnf ) THEN 177 191 IF( lwp ) WRITE(numout,*) 'No runoff needed with StandAlone Surface scheme' … … 190 204 nn_closea = 0 191 205 ENDIF 192 193 206 ! 194 207 !! following code is a bit messy, but distinguishes between when u,v are 3d arrays and 195 208 !! when we have other 3d arrays that we need to read in 196 209 !! so if a new field is added i.e. jf_new, just give it the next integer in sequence 197 !! for the corresponding dimension (currently if ln_3d_uv is true, 4 for 2d and 3 for 3d,198 !! alternatively if ln_3d_uv is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d,210 !! for the corresponding dimension (currently if ln_3d_uve is true, 4 for 2d and 3 for 3d, 211 !! alternatively if ln_3d_uve is false, 6 for 2d and 1 for 3d), reset nfld_3d, nfld_2d, 199 212 !! and the rest of the logic should still work 200 213 ! 201 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 202 ! 203 IF( ln_3d_uv ) THEN204 jf_usp = 1 ; jf_vsp = 2 205 nfld_3d = 2 206 nfld_2d = 3 214 jf_tem = 1 ; jf_sal = 2 ; jf_ssh = 3 ; jf_frq = 4 ! default 2D fields index 215 ! 216 IF( ln_3d_uve ) THEN 217 jf_usp = 1 ; jf_vsp = 2 ; jf_e3t = 3 ! define 3D fields index 218 nfld_3d = 2 + COUNT( (/lk_vvl/) ) ! number of 3D fields to read 219 nfld_2d = 3 + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 207 220 ELSE 208 jf_usp = 4 ; jf_vsp = 5 209 nfld_3d = 0 210 nfld_2d = 5 221 jf_usp = 4 ; jf_vsp = 5 ; jf_e3t = 6 ; jf_frq = 6 + COUNT( (/lk_vvl/) ) ! update 2D fields index 222 nfld_3d = 0 ! no 3D fields to read 223 nfld_2d = 5 + COUNT( (/lk_vvl/) ) + COUNT( (/ln_read_frq/) ) ! number of 2D fields to read 211 224 ENDIF 212 225 … … 216 229 CALL ctl_stop( 'sbc_ssm_init: unable to allocate slf 3d structure' ) ; RETURN 217 230 ENDIF 218 IF( ln_3d_uv ) THEN 219 slf_3d(jf_usp) = sn_usp 220 slf_3d(jf_vsp) = sn_vsp 221 ENDIF 231 slf_3d(jf_usp) = sn_usp 232 slf_3d(jf_vsp) = sn_vsp 233 IF( lk_vvl ) slf_3d(jf_e3t) = sn_e3t 222 234 ENDIF 223 235 … … 228 240 ENDIF 229 241 slf_2d(jf_tem) = sn_tem ; slf_2d(jf_sal) = sn_sal ; slf_2d(jf_ssh) = sn_ssh 230 IF( .NOT. ln_3d_uv ) THEN 242 IF( ln_read_frq ) slf_2d(jf_frq) = sn_frq 243 IF( .NOT. ln_3d_uve ) THEN 231 244 slf_2d(jf_usp) = sn_usp ; slf_2d(jf_vsp) = sn_vsp 232 ENDIF 233 ENDIF 234 ! 245 IF( lk_vvl ) slf_2d(jf_e3t) = sn_e3t 246 ENDIF 247 ENDIF 248 ! 249 ierr1 = 0 ! default definition if slf_?d(ifpr)%ln_tint = .false. 235 250 IF( nfld_3d > 0 ) THEN 236 251 ALLOCATE( sf_ssm_3d(nfld_3d), STAT=ierr ) ! set sf structure … … 265 280 ENDIF 266 281 ! 267 ! lim code currently uses surface temperature and salinity in tsn array for initialisation268 ! and ub, vb arrays in ice dynamics269 ! so allocate enough of arrays to use270 !271 ierr3 = 0272 jpm = MAX(jp_tem, jp_sal)273 ALLOCATE( tsn(jpi,jpj,1,jpm), STAT=ierr0 )274 ALLOCATE( ub(jpi,jpj,1) , STAT=ierr1 )275 ALLOCATE( vb(jpi,jpj,1) , STAT=ierr2 )276 IF ( nn_ice == 1 ) ALLOCATE( tsb(jpi,jpj,1,jpm), STAT=ierr3 )277 ierr = ierr0 + ierr1 + ierr2 + ierr3278 IF( ierr > 0 ) THEN279 CALL ctl_stop('sbc_ssm_init: unable to allocate surface arrays')280 ENDIF281 !282 282 ! finally tidy up 283 283 284 284 IF( nfld_3d > 0 ) DEALLOCATE( slf_3d, STAT=ierr ) 285 285 IF( nfld_2d > 0 ) DEALLOCATE( slf_2d, STAT=ierr ) 286 287 CALL sbc_ssm( nit000 ) ! need to define ss?_m arrays used in limistate 288 IF( .NOT. ln_read_frq ) frq_m(:,:) = 1. 289 l_initdone = .TRUE. 286 290 ! 287 291 END SUBROUTINE sbc_ssm_init -
trunk/NEMOGCM/NEMO/SAS_SRC/step.F90
r5215 r5407 17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE in_out_manager ! I/O manager 19 USE sbc_oce 20 USE sbccpl 19 21 USE iom ! 20 22 USE lbclnk … … 72 74 kstp = nit000 + Agrif_Nb_Step() 73 75 # if defined key_iomput 74 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( "nemo")76 IF( Agrif_Nbstepint() == 0 ) CALL iom_swap( cxios_context ) 75 77 # endif 76 78 #endif 77 IF( kstp == nit000 ) CALL iom_init( "nemo" )! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)79 IF( kstp == nit000 ) CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS) 78 80 IF( kstp /= nit000 ) CALL day( kstp ) ! Calendar (day was already called at nit000 in day_init) 79 CALL iom_setkt( kstp , "nemo" ) ! say to iom thatwe are at time step kstp81 CALL iom_setkt( kstp - nit000 + 1, cxios_context ) ! tell iom we are at time step kstp 80 82 81 83 CALL sbc ( kstp ) ! Sea Boundary Condition (including sea-ice) … … 86 88 ! need to keep the same interface 87 89 CALL stp_ctl( kstp, indic ) 90 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 91 ! Coupled mode 92 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 93 IF( lk_oasis ) CALL sbc_cpl_snd( kstp ) ! coupled mode : field exchanges if OASIS-coupled ice 94 88 95 #if defined key_iomput 89 IF( kstp == nitend ) CALL iom_context_finalize( "nemo" ) ! needed for XIOS+AGRIF 96 IF( kstp == nitend .OR. indic < 0 ) THEN 97 CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF 98 ENDIF 90 99 #endif 91 100 !
Note: See TracChangeset
for help on using the changeset viewer.
