!!---------------------------------------------------------------------- !! *** flx_blulk_monthly.h90 *** !!---------------------------------------------------------------------- !! flx : update surface thermohaline fluxes using bulk formulae !! and fields read in a NetCDF file !!---------------------------------------------------------------------- !! * Modules used C A U T I O N already defined in flxmod.F90 !! * Module variables INTEGER :: & ji, jj, & ! loop indices numflx, & ! logical unit for surface fluxes data nflx1 , nflx2, & ! first and second record used nflx11, nflx12 ! ??? INTEGER, PARAMETER :: jpf = 7 REAL(wp), DIMENSION(jpi,jpj,2,jpf) :: & flxdta ! 2 consecutive set of CLIO monthly fluxes !!---------------------------------------------------------------------- !! OPA 9.0 , LOCEAN-IPSL (2005) !! $Header$ !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt !!---------------------------------------------------------------------- CONTAINS SUBROUTINE flx( kt ) !!--------------------------------------------------------------------- !! *** ROUTINE flx *** !! !! ** Purpose : provide the thermohaline fluxes (heat and freshwater) !! to the ocean at each time step. !! !! ** Method : Read monthly climatological fluxes in a NetCDF file !! the net downward radiative flux qsr 1 (watt/m2) !! the net downward heat flux q 2 (watt/m2) !! the net upward water emp 3 (mm/month) !! (evaporation - precipitation) !! the climatological ice cover rclice 4 (0 or 1) !! !! Qsr and q is obtained from Esbensen-Kushnir data (opal file) with !! some corrections : !! - Data are extended over the polar area and for the net heat !! flux, values are put at 200 w/m2 on the ice regions !! - Red sea and Mediterranean values are imposed. !! !! emp is the Oberhuber climatology with a function of Levitus !! salinity !! !! rclice is an handmade climalological ice cover on the polar !! regions. !! !! runoff is an handmade climalological runoff. !! !! caution : now, in the opa global model, the net upward water flux is !! ------- with mm/day unit. !! !! History : !! ! 91-03 (O. Marti and Ph Dandin) Original code !! ! 92-07 (M. Imbard) !! ! 96-11 (E. Guilyardi) Daily AGCM input files !! ! 99-11 (M. Imbard) NetCDF FORMAT with io-ipsl !! ! 00-10 (J.-P. Boulanger) adjusted for reading any !! daily wind stress data including a climatology !! ! 01-09 (A. Lazar and C. Levy) Daily NetCDF by default !! 8.5 ! 02-09 (G. Madec) F90: Free form and module !!---------------------------------------------------------------------- !! * modules used USE iom USE blk_oce ! bulk variable USE bulk ! bulk module USE ice_oce !! * arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: jm ! dummy loop indices INTEGER :: & imois, imois2, & ! temporary integers i15 , iman ! " " REAL(wp) :: & zxy , zdtt , & ! " " zttbt , zttat , & ! " " zdtts6 ! " " !!--------------------------------------------------------------------- ! Initialization ! -------------- i15 = INT( 2 * FLOAT( nday ) / ( FLOAT( nobis(nmonth) ) + 0.5 ) ) iman = INT( raamo ) imois = nmonth + i15 - 1 IF( imois == 0 ) imois = iman imois2 = nmonth ! 1. first call kt=nit000 ! ----------------------- IF( kt == nit000 ) THEN ! initializations nflx1 = 0 nflx11 = 0 ! open the file IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' **** Routine flx_bulk_monthly.h90' WRITE(numout,*) ' ' WRITE(numout,*) ' global CLIO flx monthly fields' ENDIF CALL iom_open ( 'flx.nc', numflx ) ! temperature, spline initialization, we read the first record CALL iom_get ( numflx, jpdom_data, 'socliot1', flxdta(:,:,1,5), 1 ) 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 ) nflx2 = MOD( nflx2, iman ) IF( nflx1 == 0 ) nflx1 = 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 ! humidity CALL iom_get ( numflx, jpdom_data, 'socliohu', flxdta(:,:,1,1), nflx1 ) CALL iom_get ( numflx, jpdom_data, 'socliohu', flxdta(:,:,2,1), nflx2 ) ! 10m wind module CALL iom_get ( numflx, jpdom_data, 'socliowi', flxdta(:,:,1,2), nflx1 ) CALL iom_get ( numflx, jpdom_data, 'socliowi', flxdta(:,:,2,2), nflx2 ) ! cloud cover CALL iom_get ( numflx, jpdom_data, 'socliocl', flxdta(:,:,1,3), nflx1 ) CALL iom_get ( numflx, jpdom_data, 'socliocl', flxdta(:,:,2,3), nflx2 ) ! precipitations CALL iom_get ( numflx, jpdom_data, 'socliopl', flxdta(:,:,1,4), nflx1 ) CALL iom_get ( numflx, jpdom_data, 'socliopl', flxdta(:,:,2,4), nflx2 ) IF(lwp .AND. nitend-nit000 <= 100 ) 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,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 ) nflx12 = MOD( nflx12, iman ) IF( nflx11 == 0 ) nflx11 = 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 ! air temperature ! Utilisation d'un spline, on lit le champ a mois=nflx1 et nflx2 CALL iom_get (numflx,jpdom_data,'socliot1',flxdta(:,:,1,6),nflx11) CALL iom_get (numflx,jpdom_data,'socliot1',flxdta(:,:,2,6),nflx12) ! air temperature derivative (to reconstruct a daily field) CALL iom_get (numflx,jpdom_data,'socliot2',flxdta(:,:,1,7),nflx11) CALL iom_get (numflx,jpdom_data,'socliot2',flxdta(:,:,2,7),nflx12) IF(lwp) THEN WRITE(numout,*) WRITE(numout,*) ' read CLIO flx ok' WRITE(numout,*) DO jm = 6, jpf WRITE(numout,*) 'jpf = ', jpf !C a u t i o n : information need for SX5NEC compilo bug WRITE(numout,*) 'Clio mounth: ',nflx11,' field: ',jm,' multiply by ',0.1 CALL prihre(flxdta(:,:,1,jm),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) WRITE(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 zttbt = (REAL(nday) - 1.)/(nobis(nmonth) - 1.) 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 ) ! bulk formulea fluxes #if defined key_lim3 tatm_ice(:,:) = tatm(:,:) #endif ! ------------------- ! ! Last call kt=nitend ! ! ------------------- ! ! Closing of the numflx file (required in mpp) IF( kt == nitend ) CALL iom_close (numflx) END SUBROUTINE flx