!!---------------------------------------------------------------------- !! *** flx_bulk_daily *** !!---------------------------------------------------------------------- !!---------------------------------------------------------------------- !! bulk : reading !!---------------------------------------------------------------------- !! * Modules used C A U T I O N already defined in flxmod.F90 !! * Module variables INTEGER :: & ji, jj, & ! loop indices numfl1, numfl2, & ! logical units for surface fluxes data numfl3, numfl4, & ! nflx1 , nflx2 , & ! first and second record used ndayflx REAL(wp), DIMENSION(jpi,jpj,2,3) :: & flxdta ! 2 consecutive set of CLIO/CMAP 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 : !! ORCA FORCED VERSION WITH : !! Daily climatological NCEP temperature !! Daily climatological ERS-NCEP winds !! monthly climatological humidity and clouds !! monthly climatological CMAP precipitation !! Read several AGCM daily and monthly fluxes file !! temperature at 2m tatm (K) !! relative humidite hatm (%) !! wind speed vatm (m/s) !! monthly precip watm (kg/m2/day) from Xie/Arkin !! clouds catm (%) !! !! 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-05 (K. Rodgers) Daily Netcdf !! 8.5 ! 02-09 (C. Ethe and G. Madec) F90: Free form and MODULE !!---------------------------------------------------------------------- !! * modules used USE iom ! I/O library USE blk_oce ! bulk variable USE bulk ! bulk module !! * arguments INTEGER, INTENT( in ) :: kt ! ocean time step !! * Local declarations INTEGER :: iman,imois,i15 REAL(wp) :: zxy !!--------------------------------------------------------------------- ! Initialization ! -------------- i15 = INT(2*FLOAT(nday)/(FLOAT(nobis(nmonth))+0.5)) iman = INT( raamo ) imois = nmonth + i15 - 1 IF (imois == 0) imois = iman ! 1. first call kt = nit000 ! ----------------------- IF( kt == nit000 ) THEN ! initializations nflx1 = 0 ndayflx = 0 IF(lwp) THEN WRITE(numout,*) ' ' WRITE(numout,*) ' **** Routine flx_bulk_daily.h90' WRITE(numout,*) ' ' ENDIF ! open files IF(lwp) WRITE(numout,*) ' **** global NCEP flx daily fields ' CALL iom_open ( 'tair_1d.nc', numfl1 ) IF(lwp) WRITE(numout,*) ' **** global CLIO flx monthly fields ' CALL iom_open ( 'hum_cloud_1m.nc', numfl2 ) IF(lwp) WRITE(numout,*) ' **** global XIE flx monthly fields ' CALL iom_open ( 'rain_1m.nc', numfl3 ) IF(lwp) WRITE(numout,*) ' **** global ERS-NCEP wind daily fields ' CALL iom_open ( 'wspd_1d.nc', numfl4 ) ENDIF ! 2. Read daily DATA Temperature from NCEP ! --------------------------------------- IF( ndayflx /= nday ) THEN ndayflx = nday ! read T 2m (Caution in K) CALL iom_get ( numfl1, jpdom_data, 'air', tatm, nday_year ) IF(lwp) WRITE (numout,*)' Lecture daily flx record OK :',nday_year IF(lwp) WRITE (numout,*)' ' ! conversion of temperature Kelvin --> Celsius [rt0=273.15] tatm(:,:) = ( tatm(:,:) - rt0 ) ! read wind speed CALL iom_get ( numfl4, jpdom_data, 'wspd', vatm, nday_year ) IF(lwp) WRITE (numout,*)' Lecture daily wind speed flx :',nday_year IF(lwp) WRITE (numout,*)' ' ENDIF ! 3. Read monthly data from CLIO and From Xie ! ------------------------------------------- IF( kt == nit000 .OR. imois /= nflx1 ) THEN ! calendar computation ! nflx1 number of the first file record used in the simulation ! flx2 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 ! humidity CALL iom_get ( numfl2, jpdom_data, 'socliohu', flxdta(:,:,1,1), nflx1 ) CALL iom_get ( numfl2, jpdom_data, 'socliohu', flxdta(:,:,2,1), nflx2 ) ! clouds CALL iom_get ( numfl2, jpdom_data, 'socliocl', flxdta(:,:,1,2), nflx1 ) CALL iom_get ( numfl2, jpdom_data, 'socliocl', flxdta(:,:,2,2), nflx2 ) ! Read monthly precipitations ds flxdta(:,:,1 ou 2,4) CALL iom_get ( numfl3, jpdom_data, 'rain', flxdta(:,:,1,3), nflx1 ) CALL iom_get ( numfl3, jpdom_data, 'rain', flxdta(:,:,2,3), nflx2 ) ENDIF ! 3. at every time step linear interpolation of precipitation fluxes ! ----------------------------------------------------------- zxy = FLOAT(nday) / FLOAT(nobis(nflx1)) + 0.5 - i15 hatm(:,:) = ( (1.-zxy) * flxdta(:,:,1,1) + zxy * flxdta(:,:,2,1) ) catm(:,:) = ( (1.-zxy )* flxdta(:,:,1,2) + zxy * flxdta(:,:,2,2) ) watm(:,:) = ( (1.-zxy) * flxdta(:,:,1,3) + zxy * flxdta(:,:,2,3) ) ! 4. Closing all files ! -------------------- IF( kt == nitend ) THEN CALL iom_close (numfl1) CALL iom_close (numfl2) CALL iom_close (numfl3) CALL iom_close (numfl4) ENDIF CALL blk(kt) CALL FLUSH(numout) END SUBROUTINE flx