Changeset 10222 for NEMO/trunk/src/OFF/dtadyn.F90
- Timestamp:
- 2018-10-25T11:42:23+02:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OFF/dtadyn.F90
r10213 r10222 46 46 PRIVATE 47 47 48 PUBLIC dta_dyn_init ! called by opa.F90 49 PUBLIC dta_dyn ! called by step.F90 50 PUBLIC dta_dyn_swp ! called by step.F90 48 PUBLIC dta_dyn_init ! called by opa.F90 49 PUBLIC dta_dyn ! called by step.F90 50 PUBLIC dta_dyn_sed_init ! called by opa.F90 51 PUBLIC dta_dyn_sed ! called by step.F90 52 PUBLIC dta_dyn_swp ! called by step.F90 51 53 52 54 CHARACTER(len=100) :: cn_dir !: Root directory for location of ssr files … … 183 185 CALL prt_ctl(tab3d_1=uslp , clinfo1=' slp - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 184 186 CALL prt_ctl(tab3d_1=wslpi , clinfo1=' slp - wi: ', tab3d_2=wslpj, clinfo2=' wj: ', kdim=jpk) 185 ! CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask )186 ! CALL prt_ctl(tab2d_1=hmld , clinfo1=' hmld - : ', mask1=tmask )187 ! CALL prt_ctl(tab2d_1=fmmflx , clinfo1=' fmmflx - : ', mask1=tmask )188 ! CALL prt_ctl(tab2d_1=emp , clinfo1=' emp - : ', mask1=tmask )189 ! CALL prt_ctl(tab2d_1=wndm , clinfo1=' wspd - : ', mask1=tmask )190 ! CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask )191 187 ENDIF 192 188 ! … … 419 415 END SUBROUTINE dta_dyn_init 420 416 417 SUBROUTINE dta_dyn_sed( kt ) 418 !!---------------------------------------------------------------------- 419 !! *** ROUTINE dta_dyn *** 420 !! 421 !! ** Purpose : Prepares dynamics and physics fields from a NEMO run 422 !! for an off-line simulation of passive tracers 423 !! 424 !! ** Method : calculates the position of data 425 !! - computes slopes if needed 426 !! - interpolates data if needed 427 !!---------------------------------------------------------------------- 428 INTEGER, INTENT(in) :: kt ! ocean time-step index 429 ! 430 !!---------------------------------------------------------------------- 431 ! 432 IF( ln_timing ) CALL timing_start( 'dta_dyn_sed') 433 ! 434 nsecdyn = nsec_year + nsec1jan000 ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step 435 ! 436 IF( kt == nit000 ) THEN ; nprevrec = 0 437 ELSE ; nprevrec = sf_dyn(jf_tem)%nrec_a(2) 438 ENDIF 439 CALL fld_read( kt, 1, sf_dyn ) != read data at kt time step ==! 440 ! 441 tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature 442 tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity 443 ! 444 CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop 445 446 IF(ln_ctl) THEN ! print control 447 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, kdim=jpk ) 448 CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, kdim=jpk ) 449 ENDIF 450 ! 451 IF( ln_timing ) CALL timing_stop( 'dta_dyn_sed') 452 ! 453 END SUBROUTINE dta_dyn_sed 454 455 456 SUBROUTINE dta_dyn_sed_init 457 !!---------------------------------------------------------------------- 458 !! *** ROUTINE dta_dyn_init *** 459 !! 460 !! ** Purpose : Initialisation of the dynamical data 461 !! ** Method : - read the data namdta_dyn namelist 462 !!---------------------------------------------------------------------- 463 INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code 464 INTEGER :: ifpr ! dummy loop indice 465 INTEGER :: jfld ! dummy loop arguments 466 INTEGER :: inum, idv, idimv ! local integer 467 INTEGER :: ios ! Local integer output status for namelist read 468 !! 469 CHARACTER(len=100) :: cn_dir ! Root directory for location of core files 470 TYPE(FLD_N), DIMENSION(2) :: slf_d ! array of namelist informations on the fields to read 471 TYPE(FLD_N) :: sn_tem , sn_sal ! " " 472 !! 473 NAMELIST/namdta_dyn/cn_dir, ln_dynrnf, ln_dynrnf_depth, fwbcorr, & 474 & sn_tem, sn_sal 475 !!---------------------------------------------------------------------- 476 ! 477 REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data 478 READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901) 479 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp ) 480 REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data 481 READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 ) 482 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp ) 483 IF(lwm) WRITE ( numond, namdta_dyn ) 484 ! ! store namelist information in an array 485 ! ! Control print 486 IF(lwp) THEN 487 WRITE(numout,*) 488 WRITE(numout,*) 'dta_dyn : offline dynamics ' 489 WRITE(numout,*) '~~~~~~~ ' 490 WRITE(numout,*) ' Namelist namdta_dyn' 491 WRITE(numout,*) ' runoffs option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf 492 WRITE(numout,*) ' runoffs is spread in vertical ln_dynrnf_depth = ', ln_dynrnf_depth 493 WRITE(numout,*) ' annual global mean of empmr for ssh correction fwbcorr = ', fwbcorr 494 WRITE(numout,*) 495 ENDIF 496 ! 497 jf_tem = 1 ; jf_sal = 2 ; jfld = jf_sal 498 ! 499 slf_d(jf_tem) = sn_tem ; slf_d(jf_sal) = sn_sal 500 ! 501 ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure 502 IF( ierr > 0 ) THEN 503 CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN 504 ENDIF 505 ! ! fill sf with slf_i and control print 506 CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' ) 507 ! 508 ! Open file for each variable to get his number of dimension 509 DO ifpr = 1, jfld 510 CALL fld_clopn( sf_dyn(ifpr), nyear, nmonth, nday ) 511 idv = iom_varid( sf_dyn(ifpr)%num , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar 512 idimv = iom_file ( sf_dyn(ifpr)%num )%ndims(idv) ! number of dimension for variable sdjf%clvar 513 IF( sf_dyn(ifpr)%num /= 0 ) CALL iom_close( sf_dyn(ifpr)%num ) ! close file if already open 514 ierr1=0 515 IF( idimv == 3 ) THEN ! 2D variable 516 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 ) 517 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 ) 518 ELSE ! 3D variable 519 ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 ) 520 IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 ) 521 ENDIF 522 IF( ierr0 + ierr1 > 0 ) THEN 523 CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' ) ; RETURN 524 ENDIF 525 END DO 526 ! 527 CALL dta_dyn_sed( nit000 ) 528 ! 529 END SUBROUTINE dta_dyn_sed_init 421 530 422 531 SUBROUTINE dta_dyn_swp( kt )
Note: See TracChangeset
for help on using the changeset viewer.