[3] | 1 | !!---------------------------------------------------------------------- |
---|
| 2 | !! *** flx_forced_daily *** |
---|
| 3 | !!---------------------------------------------------------------------- |
---|
| 4 | |
---|
| 5 | !!---------------------------------------------------------------------- |
---|
| 6 | !! flx : define the thermohaline fluxes for the ocean |
---|
| 7 | !! in forced mode using flux formulation (not bulk) |
---|
| 8 | !! (read in NetCDF file) |
---|
| 9 | !!---------------------------------------------------------------------- |
---|
| 10 | !! * Modules used C A U T I O N already defined in flxmod.F90 |
---|
| 11 | |
---|
| 12 | !! * Module variables |
---|
| 13 | INTEGER :: & |
---|
| 14 | numflx, & ! logical unit for surface fluxes data |
---|
| 15 | nflx1, nflx2, & ! first and second record used |
---|
| 16 | nflx11, nflx12, & ! ??? |
---|
| 17 | ndayflx, & ! new day for ecmwf flx forcing |
---|
| 18 | nyearflx ! new year for ecmwf flx forcing |
---|
| 19 | REAL(wp), DIMENSION(jpi,jpj,3) :: & |
---|
| 20 | flxdta ! 3 consecutive daily fluxes |
---|
| 21 | !!---------------------------------------------------------------------- |
---|
[247] | 22 | !! OPA 9.0 , LOCEAN-IPSL (2005) |
---|
| 23 | !! $Header$ |
---|
| 24 | !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt |
---|
[3] | 25 | !!---------------------------------------------------------------------- |
---|
| 26 | |
---|
| 27 | CONTAINS |
---|
| 28 | |
---|
| 29 | SUBROUTINE flx( kt ) |
---|
| 30 | !!--------------------------------------------------------------------- |
---|
| 31 | !! *** ROUTINE flx *** |
---|
| 32 | !! |
---|
| 33 | !! ** Purpose : provide the thermohaline fluxes (heat and freshwater) |
---|
| 34 | !! to the ocean at each time step. |
---|
| 35 | !! |
---|
| 36 | !! ** Method : READ daily flux file in NetCDF files |
---|
| 37 | !! the net downward radiative flux qsr 1 (watt/m2) |
---|
| 38 | !! the net downward heat flux q 2 (watt/m2) |
---|
| 39 | !! the net upward water emp 3 (kg/m2/s) |
---|
| 40 | !! (evaporation - precipitation) |
---|
| 41 | !! |
---|
| 42 | !! History : |
---|
| 43 | !! ! 90-03 (O. Marti and P. Dandin) Original code |
---|
| 44 | !! ! 92-07 (M. Imbard) |
---|
| 45 | !! ! 96-11 (E. Guilyardi) Daily AGCM input files |
---|
| 46 | !! ! 99-11 (M. Imbard) NetCDF FORMAT with ioipsl |
---|
| 47 | !! ! 00-10 (J.-P. Boulanger) adjusted for reading any |
---|
| 48 | !! daily wind stress data including a climatology |
---|
| 49 | !! ! 01-09 (A. Lazar and C. Levy) config with no ice model |
---|
| 50 | !! 8.5 ! 03-07 (G. Madec) F90: Free form and module |
---|
| 51 | !!---------------------------------------------------------------------- |
---|
| 52 | !! * Modules used |
---|
| 53 | USE ioipsl |
---|
| 54 | USE flx_oce |
---|
| 55 | |
---|
| 56 | !! * arguments |
---|
| 57 | INTEGER, INTENT( in ) :: kt ! ocean time step |
---|
| 58 | |
---|
| 59 | !! * local declarations |
---|
| 60 | INTEGER :: ji, jj, jk ! dummy loop arguments |
---|
| 61 | INTEGER :: iprint |
---|
| 62 | INTEGER :: i15, iy, iday, idy, ipi, ipj, ipk |
---|
| 63 | INTEGER ,DIMENSION(366) :: istep |
---|
| 64 | |
---|
| 65 | REAL(wp), DIMENSION(jpi,jpj) :: zlon, zlat |
---|
| 66 | REAL(wp), DIMENSION(jpi,jpj) :: zeri, zerps, ziclim |
---|
| 67 | REAL(wp), DIMENSION(jpk) :: zlev |
---|
| 68 | REAL(wp) :: zdate0, zdt |
---|
| 69 | |
---|
| 70 | CHARACTER (len=40) :: clname |
---|
| 71 | !!--------------------------------------------------------------------- |
---|
| 72 | |
---|
| 73 | ! Initialization |
---|
| 74 | ! ----------------- |
---|
| 75 | |
---|
| 76 | ! year month day |
---|
| 77 | i15 = INT( 2.* FLOAT(nday) / (FLOAT( nobis(nmonth) ) + 0.5) ) |
---|
| 78 | ipi = jpiglo |
---|
| 79 | ipj = jpjglo |
---|
| 80 | ipk = jpk |
---|
| 81 | IF( nleapy == 0 ) THEN |
---|
| 82 | idy = 365 |
---|
| 83 | ELSE IF( nleapy == 1 ) THEN |
---|
| 84 | IF( MOD( nyear ,4 ) == 0 ) THEN |
---|
| 85 | idy = 366 |
---|
| 86 | ELSE |
---|
| 87 | idy = 365 |
---|
| 88 | ENDIF |
---|
| 89 | ELSE IF( nleapy == 30 ) THEN |
---|
| 90 | IF(lwp) WRITE(numout,cform_err) |
---|
| 91 | IF(lwp) WRITE(numout,*)'flx.forced.h : nleapy = 30 is non compatible' |
---|
| 92 | IF(lwp) WRITE(numout,*)' with existing files' |
---|
| 93 | nstop = nstop + 1 |
---|
| 94 | ENDIF |
---|
| 95 | |
---|
| 96 | |
---|
| 97 | ! First call kt=nit000 |
---|
| 98 | ! -------------------- |
---|
| 99 | |
---|
| 100 | IF( kt == nit000 ) THEN |
---|
| 101 | IF(lwp) WRITE(numout,*) |
---|
| 102 | IF(lwp) WRITE(numout,*) 'flx : daily fluxes Q, Qsr, EmP' |
---|
| 103 | IF(lwp) WRITE(numout,*) '~~ ' |
---|
| 104 | ndayflx = 0 |
---|
| 105 | nyearflx = 0 |
---|
| 106 | ENDIF |
---|
| 107 | |
---|
| 108 | |
---|
| 109 | ! Open files if nyearflx |
---|
| 110 | ! ---------------------- |
---|
| 111 | |
---|
| 112 | IF( nyearflx /= nyear ) THEN |
---|
| 113 | nyearflx = nyear |
---|
| 114 | iprint = 1 |
---|
| 115 | |
---|
| 116 | ! Define file name and record |
---|
| 117 | |
---|
| 118 | ! Close/open file if new year |
---|
| 119 | |
---|
[389] | 120 | IF( nyearflx /= 0 .AND. kt /= nit000 ) CALL flinclo(numflx) |
---|
[3] | 121 | |
---|
| 122 | iy = nyear |
---|
| 123 | IF(lwp) WRITE (numout,*) iy |
---|
| 124 | WRITE(clname,'("flx_1d.nc")') |
---|
[392] | 125 | #if defined key_agrif |
---|
[389] | 126 | if ( .NOT. Agrif_Root() ) then |
---|
| 127 | clname = TRIM(Agrif_CFixed())//'_'//TRIM(clname) |
---|
| 128 | endif |
---|
| 129 | #endif |
---|
[3] | 130 | IF(lwp) WRITE (numout,*)' open flx file = ',clname |
---|
| 131 | CALL FLUSH(numout) |
---|
| 132 | |
---|
| 133 | CALL flinopen(clname,mig(1),nlci,mjg(1),nlcj,.FALSE.,ipi,ipj & |
---|
| 134 | ,ipk,zlon,zlat,zlev,idy,istep,zdate0,zdt,numflx) |
---|
| 135 | |
---|
| 136 | IF( ipi /= jpidta .AND. ipj /= jpjdta .AND. ipk /= 1 ) THEN |
---|
| 137 | IF(lwp) WRITE(numout,cform_err) |
---|
| 138 | IF(lwp) WRITE(numout,*) |
---|
| 139 | IF(lwp) WRITE(numout,*) 'problem with dimensions' |
---|
| 140 | IF(lwp) WRITE(numout,*) ' ipi ',ipi,' jpidta ',jpidta |
---|
| 141 | IF(lwp) WRITE(numout,*) ' ipj ',ipj,' jpjdta ',jpjdta |
---|
| 142 | IF(lwp) WRITE(numout,*) ' ipk ',ipk,' =? 1' |
---|
| 143 | nstop = nstop + 1 |
---|
| 144 | ENDIF |
---|
| 145 | IF(lwp) WRITE(numout,*) idy,istep,zdate0,zdt,numflx |
---|
| 146 | ELSE |
---|
| 147 | iprint = 0 |
---|
| 148 | ENDIF |
---|
| 149 | |
---|
| 150 | ! Read daily fluxes in flxdta(1,1,jm) |
---|
| 151 | ! 1. Qtot (w/m2) |
---|
| 152 | ! 2. Qsr (w/m2) |
---|
| 153 | ! 3. emp (kg/m2/s) |
---|
| 154 | |
---|
| 155 | IF( ndayflx /= nday ) THEN |
---|
| 156 | ndayflx = nday |
---|
| 157 | |
---|
| 158 | iday = nday_year |
---|
| 159 | |
---|
| 160 | ! read Qtot |
---|
| 161 | CALL flinget(numflx,'sohefldo',jpidta,jpjdta,1,idy,iday, & |
---|
| 162 | iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,1)) |
---|
| 163 | ! read qsr |
---|
| 164 | CALL flinget(numflx,'soshfldo',jpidta,jpjdta,1,idy,iday, & |
---|
| 165 | iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,2)) |
---|
| 166 | ! read emp |
---|
| 167 | CALL flinget(numflx,'sowaflup',jpidta,jpjdta,1,idy,iday, & |
---|
| 168 | iday,mig(1),nlci,mjg(1),nlcj,flxdta(1:nlci,1:nlcj,3)) |
---|
| 169 | |
---|
| 170 | IF(lwp) WRITE (numout,*)'Lecture flx record :',iday |
---|
| 171 | |
---|
| 172 | IF( nit000 == 1 ) THEN |
---|
| 173 | IF( kt == nit000 ) THEN |
---|
| 174 | IF(lwp) THEN |
---|
| 175 | WRITE(numout,*) |
---|
| 176 | WRITE(numout,*) ' read daily fluxes ok' |
---|
| 177 | WRITE(numout,*) |
---|
| 178 | WRITE(numout,*) ' Q * .1, day: ',ndastp |
---|
[389] | 179 | CALL prihre(flxdta(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) |
---|
[3] | 180 | WRITE(numout,*) |
---|
| 181 | WRITE(numout,*) ' QSR * .1, day: ',ndastp |
---|
[389] | 182 | CALL prihre(flxdta(:,:,2),jpi,jpj,1,jpi,20,1,jpj,10,.1,numout) |
---|
[3] | 183 | WRITE(numout,*) |
---|
| 184 | WRITE(numout,*) ' E-P *86400, day: ',ndastp |
---|
[389] | 185 | CALL prihre(flxdta(:,:,3),jpi,jpj,1,jpi,20,1,jpj,10,86400.,numout) |
---|
[3] | 186 | WRITE(numout,*) ' ' |
---|
| 187 | ENDIF |
---|
| 188 | ENDIF |
---|
| 189 | ENDIF |
---|
| 190 | ENDIF |
---|
| 191 | |
---|
| 192 | p_qt (:,:) = flxdta(:,:,1) |
---|
| 193 | p_qsr(:,:) = flxdta(:,:,2) |
---|
| 194 | p_emp(:,:) = flxdta(:,:,3) |
---|
| 195 | |
---|
| 196 | ! Boundary condition on emp for free surface option |
---|
| 197 | ! ------------------------------------------------- |
---|
| 198 | CALL lbc_lnk( p_emp, 'T', 1. ) |
---|
| 199 | |
---|
| 200 | |
---|
| 201 | ! Closing all files |
---|
| 202 | ! ----------------- |
---|
| 203 | |
---|
| 204 | IF( kt == nitend ) CALL flinclo( numflx ) |
---|
| 205 | |
---|
| 206 | END SUBROUTINE flx |
---|