source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/surf_ocean_mod.F90 @ 3837

Last change on this file since 3837 was 1299, checked in by Laurent Fairhead, 15 years ago

Nettoyage general pour se rapprocher des normes et éviter des erreurs a la
compilation:

  • tous les FLOAT() sont remplacés par des REAL()
  • tous les STOP dans phylmd sont remplacés par des appels à abort_gcm
  • le common control défini dans le fichier control.h est remplacé par le module control_mod pour éviter des messages sur l'alignement des variables dans les déclarations
  • des $Header$ remplacés par des $Id$ pour svn

Quelques remplacements à faire ont pu m'échapper

General cleanup of the code to try and adhere to norms and to prevent some
compilation errors:

  • all FLOAT() instructions have been replaced by REAL() instructions
  • all STOP instructions in phylmd have been replaced by calls to abort_gcm
  • the common block control defined in the control.h file has been replaced by the control_mod to prevent compilation warnings on the alignement of declared variables
  • $Header$ replaced by $Id$ for svn

Some changes which should have been made might have escaped me
  • Property svn:eol-style set to native
  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 7.1 KB
RevLine 
[781]1!
2MODULE surf_ocean_mod
3
4  IMPLICIT NONE
5
6CONTAINS
7!
8!****************************************************************************************
9!
[888]10  SUBROUTINE surf_ocean(rlon, rlat, swnet, lwnet, alb1, &
[996]11       rugos, windsp, rmu0, fder, tsurf_in, &
[781]12       itime, dtime, jour, knon, knindex, &
[1067]13       p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum, &
14       AcoefH, AcoefQ, BcoefH, BcoefQ, &
15       AcoefU, AcoefV, BcoefU, BcoefV, &
16       ps, u1, v1, rugoro, pctsrf, &
[888]17       snow, qsurf, agesno, &
18       z0_new, alb1_new, alb2_new, evap, fluxsens, fluxlat, &
[1067]19       tsurf_new, dflux_s, dflux_l, lmt_bils, &
20       flux_u1, flux_v1)
21
22  USE dimphy
23  USE surface_data, ONLY     : type_ocean
24  USE ocean_forced_mod, ONLY : ocean_forced_noice
25  USE ocean_slab_mod, ONLY   : ocean_slab_noice
26  USE ocean_cpl_mod, ONLY    : ocean_cpl_noice
[781]27!
28! This subroutine will make a call to ocean_XXX_noice according to the ocean mode (force,
29! slab or couple). The calculations of albedo and rugosity for the ocean surface are
30! done in here because they are identical for the different modes of ocean.
31!
[793]32    INCLUDE "indicesol.h"
33    INCLUDE "YOMCST.h"
[781]34
35! Input variables
36!****************************************************************************************
37    INTEGER, INTENT(IN)                      :: itime, jour, knon
38    INTEGER, DIMENSION(klon), INTENT(IN)     :: knindex
39    REAL, INTENT(IN)                         :: dtime
40    REAL, DIMENSION(klon), INTENT(IN)        :: rlon, rlat
[888]41    REAL, DIMENSION(klon), INTENT(IN)        :: swnet  ! net shortwave radiation at surface 
42    REAL, DIMENSION(klon), INTENT(IN)        :: lwnet  ! net longwave radiation at surface 
43    REAL, DIMENSION(klon), INTENT(IN)        :: alb1   ! albedo in visible SW interval
[781]44    REAL, DIMENSION(klon), INTENT(IN)        :: rugos
45    REAL, DIMENSION(klon), INTENT(IN)        :: windsp
46    REAL, DIMENSION(klon), INTENT(IN)        :: rmu0 
47    REAL, DIMENSION(klon), INTENT(IN)        :: fder
[996]48    REAL, DIMENSION(klon), INTENT(IN)        :: tsurf_in
[781]49    REAL, DIMENSION(klon), INTENT(IN)        :: p1lay
[1067]50    REAL, DIMENSION(klon), INTENT(IN)        :: cdragh
51    REAL, DIMENSION(klon), INTENT(IN)        :: cdragm
[781]52    REAL, DIMENSION(klon), INTENT(IN)        :: precip_rain, precip_snow
53    REAL, DIMENSION(klon), INTENT(IN)        :: temp_air, spechum
[1067]54    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefH, AcoefQ, BcoefH, BcoefQ
55    REAL, DIMENSION(klon), INTENT(IN)        :: AcoefU, AcoefV, BcoefU, BcoefV
[781]56    REAL, DIMENSION(klon), INTENT(IN)        :: ps
[1067]57    REAL, DIMENSION(klon), INTENT(IN)        :: u1, v1
[781]58    REAL, DIMENSION(klon), INTENT(IN)        :: rugoro
59    REAL, DIMENSION(klon,nbsrf), INTENT(IN)  :: pctsrf
60
61! In/Output variables
62!****************************************************************************************
[888]63    REAL, DIMENSION(klon), INTENT(INOUT)     :: snow
64    REAL, DIMENSION(klon), INTENT(INOUT)     :: qsurf
[781]65    REAL, DIMENSION(klon), INTENT(INOUT)     :: agesno
66
67! Output variables
68!****************************************************************************************
69    REAL, DIMENSION(klon), INTENT(OUT)       :: z0_new
[888]70    REAL, DIMENSION(klon), INTENT(OUT)       :: alb1_new  ! new albedo in visible SW interval
71    REAL, DIMENSION(klon), INTENT(OUT)       :: alb2_new  ! new albedo in near IR interval
[781]72    REAL, DIMENSION(klon), INTENT(OUT)       :: evap, fluxsens, fluxlat
[888]73    REAL, DIMENSION(klon), INTENT(OUT)       :: tsurf_new
[781]74    REAL, DIMENSION(klon), INTENT(OUT)       :: dflux_s, dflux_l     
[996]75    REAL, DIMENSION(klon), INTENT(OUT)       :: lmt_bils
[1067]76    REAL, DIMENSION(klon), INTENT(OUT)       :: flux_u1, flux_v1
[781]77
78! Local variables
79!****************************************************************************************
80    INTEGER               :: i
[1146]81    REAL                  :: tmp
82    REAL, PARAMETER       :: cepdu2=(0.1)**2
[781]83    REAL, DIMENSION(klon) :: alb_eau
[888]84    REAL, DIMENSION(klon) :: radsol
[781]85
86! End definition
87!****************************************************************************************
[888]88
89
90!****************************************************************************************
91! Calculate total net radiance at surface
92!
93!****************************************************************************************
94    radsol(:) = 0.0
95    radsol(1:knon) = swnet(1:knon) + lwnet(1:knon)
96
97!****************************************************************************************
[781]98! Switch according to type of ocean (couple, slab or forced)
99!****************************************************************************************
[996]100    SELECT CASE(type_ocean)
[781]101    CASE('couple')
[888]102       CALL ocean_cpl_noice( &
103            swnet, lwnet, alb1, &
[1067]104            windsp, fder, &
[781]105            itime, dtime, knon, knindex, &
[1067]106            p1lay, cdragh, cdragm, precip_rain, precip_snow,temp_air,spechum,&
107            AcoefH, AcoefQ, BcoefH, BcoefQ, &
108            AcoefU, AcoefV, BcoefU, BcoefV, &
109            ps, u1, v1, &
[888]110            radsol, snow, agesno, &
[1067]111            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]112            tsurf_new, dflux_s, dflux_l)
[781]113
114    CASE('slab')
[888]115       CALL ocean_slab_noice( &
[996]116            itime, dtime, jour, knon, knindex, &
[1067]117            p1lay, cdragh, cdragm, precip_rain, precip_snow, temp_air, spechum,&
118            AcoefH, AcoefQ, BcoefH, BcoefQ, &
119            AcoefU, AcoefV, BcoefU, BcoefV, &
120            ps, u1, v1, tsurf_in, &
[888]121            radsol, snow, agesno, &
[1067]122            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]123            tsurf_new, dflux_s, dflux_l, lmt_bils)
[781]124       
125    CASE('force')
[888]126       CALL ocean_forced_noice( &
127            itime, dtime, jour, knon, knindex, &
[1067]128            p1lay, cdragh, cdragm, precip_rain, precip_snow, &
[781]129            temp_air, spechum, &
[1067]130            AcoefH, AcoefQ, BcoefH, BcoefQ, &
131            AcoefU, AcoefV, BcoefU, BcoefV, &
132            ps, u1, v1, &
[888]133            radsol, snow, agesno, &
[1067]134            qsurf, evap, fluxsens, fluxlat, flux_u1, flux_v1, &
[996]135            tsurf_new, dflux_s, dflux_l)
[781]136    END SELECT
137
138!****************************************************************************************
139! Calculate albedo
140!
141!****************************************************************************************
142    IF ( MINVAL(rmu0) == MAXVAL(rmu0) .AND. MINVAL(rmu0) == -999.999 ) THEN
[1299]143       CALL alboc(REAL(jour),rlat,alb_eau)
[781]144    ELSE  ! diurnal cycle
145       CALL alboc_cd(rmu0,alb_eau)
146    ENDIF
147
148    DO i =1, knon
[888]149       alb1_new(i) = alb_eau(knindex(i))
[781]150    ENDDO
[888]151    alb2_new(1:knon) = alb1_new(1:knon)
[781]152
153!****************************************************************************************
154! Calculate the rugosity
155!
156!****************************************************************************************
157    DO i = 1, knon
[1146]158       tmp = MAX(cepdu2,u1(i)**2+v1(i)**2)
[1067]159       z0_new(i) = 0.018*cdragm(i) * (u1(i)**2+v1(i)**2)/RG  &
[1146]160            +  0.11*14e-6 / SQRT(cdragm(i) * tmp)
[781]161       z0_new(i) = MAX(1.5e-05,z0_new(i))
[1146]162    ENDDO   
[781]163!
164!****************************************************************************************
165!   
166  END SUBROUTINE surf_ocean
167!
168!****************************************************************************************
169!
170END MODULE surf_ocean_mod
Note: See TracBrowser for help on using the repository browser.