!!---------------------------------------------------------------------- !! *** tau_forced_monthly_fdir.h90 *** !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! tau : update surface stress from monthly mean fields read in !! a direct access file !!---------------------------------------------------------------------- !! * local modules variables INTEGER :: & numtau = 64, & ! logical unit for the i-component of the wind data ntau1, ntau2 ! index of the first and second record used CHARACTER (len=32) :: & cl_tau = 'tauxy_1m' & ! ! name of the monthly direct acces file ! ! which containt the 2 surface stress components REAL(wp), DIMENSION(jpi,jpj,2,4) :: & taudta ! the 2 components of the surface stress (Pascal) ! ! at 2 consecutive time-steps in the (i,j) referential !!---------------------------------------------------------------------- !! OPA 9.0 , LODYC-IPSL (2003) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE tau( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE tau *** !! !! ** Purpose : provide to the ocean the stress at each time step !! !! ** Method : - Read the 2 monthly surface stress components in a !! direct access file at 2 consecutive time-steps !! They are given in the (i,j) referential !! The i-component is given at U-point (INTERP package) !! The j-component is given at V-point (INTERP package) !! - a linear time-interpolation is performed to provide !! the stress at the kt time-step. !! !! CAUTION: never mask the surface stress field ! !! !! ** Action : !! update at each time-step the two components of the surface !! stress in both (i,j) and geographical referencial !! !! History : !! 4.0 ! 91-03 (G. Madec) Original code !! 8.5 ! 02-11 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: ji, jj, ios INTEGER :: iimlu, ijmlu, ikmlu, ilmlu, immlu INTEGER :: imois, iman INTEGER :: i15 INTEGER :: ildta,ibloc,ilseq CHARACTER (len=30) :: cltit CHARACTER (len=21) :: clunf, clold, cldir REAL(wp) :: zxy, zfacto REAL(wp), DIMENSION(jpi,jpj) :: ztauxg, ztauyg !!--------------------------------------------------------------------- ! 0. Initialization ! ----------------- ! Open specifier clold = 'OLD' clunf = 'UNFORMATTED' cldir = 'DIRECT' ilseq = 1 ! computation of the record length for direct access file ! this length depend of 4096 (device specification) ibloc = 4096 ildta = ibloc*((jpidta*jpjdta*jpbytda-1 )/ibloc+1) ! iman=number of dates in data file (12 for a year of monthly values) iman = int(raamo) i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) imois = nmonth + i15 - 1 IF ( imois == 0 ) imois = iman ! 1. first call kt=nit000 ! ----------------------- IF( kt == nit000 ) THEN ntau1 = 0 IF(lwp) WRITE(numout,*) ' ' IF(lwp) WRITE(numout,*) ' tau : monthly stress direct access file' IF(lwp) WRITE(numout,*) ' ~~~~~~' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'file numtau = ', numtau ! title, dimensions and tests CALL ctlopn(numtau, cl_tau, clold, clunf, cldir, ildta, numout, lwp, 1 ) READ ( numtau, REC=1, IOSTAT=ios ) cltit, iimlu, ijmlu, ikmlu, ilmlu, immlu IF(lwp) WRITE(numout,*)' number of points in the 5 directions ' IF(lwp) WRITE(numout,*) iimlu, ijmlu, ikmlu, ilmlu, immlu ENDIF ! 2. Read monthly file ! ------------------- IF ( kt == nit000 .OR. imois /= ntau1 ) THEN ! 2.1 calendar computation ! ntau1 number of the first file record used in the simulation ! ntau2 number of the last file record ntau1 = imois ntau2 = ntau1+1 ntau1 = mod( ntau1, iman ) IF ( ntau1 == 0 ) ntau1 = iman ntau2 = MOD( ntau2, iman ) IF ( ntau2 == 0 ) ntau2 = iman IF(lwp) WRITE(numout,*) 'first record file used ntau1 ', ntau1 IF(lwp) WRITE(numout,*) 'last record file used ntau2 ', ntau2 ! 2.3 Read monthly stress data Hellerman ! ntau1 ! ...Txu CALL read2D(numtau,taudta(1,1,1,1),1,6*(ntau1-1)+3) ! ...Txv CALL read2D(numtau,taudta(1,1,1,2),1,6*(ntau1-1)+4) ! ...Tyu CALL read2D(numtau,taudta(1,1,1,3),1,6*(ntau1-1)+6) ! ...Tyv CALL read2D(numtau,taudta(1,1,1,4),1,6*(ntau1-1)+7) ! ntau2 ! ...Txu CALL read2D(numtau,taudta(1,1,2,1),1,6*(ntau2-1)+3) ! ...Txv CALL read2D(numtau,taudta(1,1,2,2),1,6*(ntau2-1)+4) ! ...Tyu CALL read2D(numtau,taudta(1,1,2,3),1,6*(ntau2-1)+6) ! ...Tyv CALL read2D(numtau,taudta(1,1,2,4),1,6*(ntau2-1)+7) IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' read Clio stress ok' WRITE(numout,*) ' ' WRITE(numout,*) ' month: ', ntau1, ' field: 1 multiply by ', 1. CALL prihre( taudta(1,1,1,1), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) WRITE(numout,*) ' ' WRITE(numout,*) ' month: ', ntau2, ' field: 2 multiply by ', 1. CALL prihre( taudta(1,1,2,4), jpi, jpj, 1, jpi, 20, 1, jpj, 10, 1., numout ) ENDIF ENDIF ! 4. At every time step compute stress data ! ----------------------------------------- zfacto = 1. ! zxy : coefficient for linear interpolation in time zxy = FLOAT( nday ) / FLOAT( nobis(ntau1) ) + 0.5 - i15 ! ...Txu tauxg (:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,1) + zxy * taudta(:,:,2,1) ) ! ...Tyu tauyg (:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,3) + zxy * taudta(:,:,2,3) ) ! ...Txv ztauxg(:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,2) + zxy * taudta(:,:,2,2) ) ! ...Tyv ztauyg(:,:) = zfacto * ( (1.-zxy) * taudta(:,:,1,4) + zxy * taudta(:,:,2,4) ) ! 2.4 changing data grid coordinates --> global grid coordinates CALL repcmo( tauxg, tauyg, ztauxg, ztauyg, taux, tauy, kt ) ! 2.5 Save components tauxg(:,:) = taux(:,:) tauyg(:,:) = tauy(:,:) CALL FLUSH(numout) GO TO 412 410 IF(lwp)WRITE(numout,*) 'e r r o r read numtau ', ios nstop = nstop +1 412 CONTINUE END SUBROUTINE tau