!!---------------------------------------------------------------------- !! *** flx_bulk_monthly_fdir.h90 *** !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! flx : define the thermohaline fluxes for the ocean using !! bulk formulea and monthly mean fields read in direct !! access files. !!---------------------------------------------------------------------- !! * Modules used C A U T I O N already defined in flxmod.F90 !! * Module variables INTEGER :: & numfl1, numfl2, & ! logical units for surface fluxes data numfl3, numfl4, & ! numfl5, & ! nflx1, nflx2, & ! first and second record used nflx11, nflx12 ! ??? REAL(wp), DIMENSION(jpi,jpj,2,7) :: & flxdta ! 2 consecutive set of CLIO monthly fluxes !!---------------------------------------------------------------------- !! OPA 9.0 , LODYC-IPSL (2003) !!---------------------------------------------------------------------- CONTAINS SUBROUTINE flx( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE flx *** !! !! ** Purpose : provide the thermohaline fluxes (heat and freshwater) !! to the ocean at each time step. !! !! ** Method : bulk formulae with monthly mean fields read in direct !! access file !! !! ** Method : !! !! History : !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * Modules used USE bulk !! * arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER, PARAMETER :: jpnk=1, jpmois=12, jpf=7 INTEGER :: ji, jj, jm, ios, jt INTEGER :: iimlu, ijmlu, ikmlu, ilmlu, immlu INTEGER :: imois, iman, imois2, i15 REAL(wp) :: zpdtan,zman,zpdtmo,zdemi REAL(wp) :: zxy,zdtt,zdatet,zttbt,zttat REAL(wp) :: zdtts6 INTEGER :: ildta,ibloc,ilseq CHARACTER (len=30) :: cltit CHARACTER (len=21) :: clunf,clold,cldir CHARACTER (len=32) :: clname !!--------------------------------------------------------------------- ! 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) zpdtan= raass/rdttra(1) zman = 12. iman = int(zman) zpdtmo= zpdtan/zman zdemi = zpdtmo/2. i15 = INT( 2.* FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) imois = nmonth + i15 - 1 IF( imois == 0 ) imois = iman imois2 = nmonth numfl2=81 numfl3=82 numfl4=83 numfl5=84 ! First call kt=nit000 ! -------------------- IF( kt == nit000 ) THEN nflx1 = 0 nflx11 = 0 IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' **** flx ' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'read global ocean fluxes ' IF(lwp) WRITE(numout,9100) zpdtmo,zdemi IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) ' read global ocean monthly fields' IF(lwp) WRITE(numout,*) ' --------------------------------' IF(lwp) WRITE(numout,*) IF(lwp) WRITE(numout,*) 'opal file numfl1 = ',numfl1 9100 FORMAT (' esbensen : zpdtmo,zdemi :',2f12.3) ! Read first records ! title, dimensions and tests clname='humidata_clio_orca' CALL ctlopn(numfl1,clname,clold,clunf,cldir,ildta,numout,lwp,1) READ (numfl1,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu clname='winddata_clio_orca' CALL ctlopn(numfl2,clname,clold,clunf,cldir,ildta,numout,lwp,1) READ (numfl2,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu clname='berdata_clio_orca' CALL ctlopn(numfl3,clname,clold,clunf,cldir,ildta,numout,lwp,1) READ (numfl3,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu clname='xuedata_clio_orca' CALL ctlopn(numfl4,clname,clold,clunf,cldir,ildta,numout,lwp,1) READ (numfl4,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu clname='ncardata_spline_orca' CALL ctlopn(numfl5,clname,clold,clunf,cldir,ildta,numout,lwp,1) READ (numfl5,REC=1,IOSTAT=ios) cltit,iimlu,ijmlu,ikmlu,ilmlu,immlu ! temperature ! Utilisation d'un spline, on lit le champ a mois=1 CALL read2D(numfl5,flxdta(1,1,1,5),1,3) ENDIF ! Read monthly file ! ---------------- IF( kt == nit000 .OR. imois /= nflx1 ) THEN ! Calendar computation ! nflx1 number of the first file record used in the simulation ! nflx2 number of the last file record nflx1 = imois nflx2 = nflx1+1 nflx1 = MOD(nflx1,iman) IF( nflx1 == 0 ) nflx1 = iman nflx2 = MOD(nflx2,iman) IF( nflx2 == 0 ) nflx2 = iman IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1 IF(lwp) WRITE(numout,*) 'last record file used nflx2 ',nflx2 ! Read monthly fluxes data Esbensen Kushnir ! humidite CALL read2D(numfl1,flxdta(1,1,1,1),1,nflx1+1) CALL read2D(numfl1,flxdta(1,1,2,1),1,nflx2+1) ! vent CALL read2D(numfl2,flxdta(1,1,1,2),1,nflx1+1) CALL read2D(numfl2,flxdta(1,1,2,2),1,nflx2+1) ! nuages CALL read2D(numfl3,flxdta(1,1,1,3),1,nflx1+1) CALL read2D(numfl3,flxdta(1,1,2,3),1,nflx2+1) ! precipitations CALL read2D(numfl4,flxdta(1,1,1,4),1,nflx1+1) CALL read2D(numfl4,flxdta(1,1,2,4),1,nflx2+1) ! temperature ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2 ! CALL read2D(numfl5,flxdta(1,1,1,6),1,3*(nflx1-1)+3) ! CALL read2D(numfl5,flxdta(1,1,2,6),1,3*(nflx2-1)+3) ! on lit la derivee ! CALL read2D(numfl5,flxdta(1,1,1,7),1,3*(nflx1-1)+4) ! CALL read2D(numfl5,flxdta(1,1,2,7),1,3*(nflx2-1)+4) IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' read clio flx ok' WRITE(numout,*) DO jm = 1, 4 WRITE(numout,*) WRITE(numout,*) 'Clio mounth: ',nflx1,' field: ',jm,' multiply by ',0.1 CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) END DO ENDIF ENDIF IF( kt == nit000 .OR. imois2 /= nflx11 ) THEN ! calendar computation ! nflx1 number of the first file record used in the simulation ! nflx2 number of the last file record nflx11 = imois2 nflx12 = nflx11+1 nflx11 = MOD(nflx11,iman) IF( nflx11 == 0 ) nflx11 = iman nflx12 = MOD(nflx12,iman) IF( nflx12 == 0 ) nflx12 = iman IF(lwp) WRITE(numout,*) 'first record file used nflx11 ',nflx11 IF(lwp) WRITE(numout,*) 'last record file used nflx12 ',nflx12 ! Read monthly fluxes data Esbensen Kushnir ! temperature ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2 CALL read2D(numfl5,flxdta(1,1,1,6),1,3*(nflx11-1)+3) CALL read2D(numfl5,flxdta(1,1,2,6),1,3*(nflx12-1)+3) ! on lit la derivee CALL read2D(numfl5,flxdta(1,1,1,7),1,3*(nflx11-1)+4) CALL read2D(numfl5,flxdta(1,1,2,7),1,3*(nflx12-1)+4) IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' read CLIO flx ok' WRITE(numout,*) DO jm = 6, jpf WRITE(numout,*) WRITE(numout,*) 'Clio mounth: ',nflx11,' field: ',jm,' multiply by ',0.1 CALL prihre(flxdta(1,1,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) END DO ENDIF ENDIF ! 3. at every time step interpolation of fluxes ! --------------------------------------------- zxy = FLOAT(nday) / FLOAT(nobis(nflx1)) + 0.5 - i15 zdtt = raajj/raamo zdatet = 0. DO jt = 1, nmonth-1 zdatet = zdatet + nobis(jt) END DO zdatet = ( zdatet + FLOAT(nday) -1. )/zdtt zttbt = zdatet - int(zdatet) zttat = 1. - zttbt zdtts6 = zdtt/6. hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) ) vatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) ) catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) ) watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,4) + zxy * flxdta(:,:,2,4) ) tatm(:,:) = ( flxdta(:,:,2,6) - flxdta(:,:,1,6) )/zdtt & - ((3. * zttat * zttat - 1.) * flxdta(:,:,1,7) & - ( 3. * zttbt * zttbt - 1.) * flxdta(:,:,2,7) ) * zdtts6 & + flxdta(:,:,1,5) CALL blk(kt) CALL FLUSH(numout) ! ------------------- ! ! Last call kt=nitend ! ! ------------------- ! ! Closing of the 5 files (required in mpp) ????? it smells bug ... IF( kt == nitend ) THEN CALL flinclo(numfl1) CALL flinclo(numfl2) CALL flinclo(numfl3) CALL flinclo(numfl4) CALL flinclo(numfl5) ENDIF END SUBROUTINE flx