Ignore:
Timestamp:
Sep 9, 2008, 3:22:23 PM (16 years ago)
Author:
lsce
Message:
  • Modifications liées au calcul des nouveau sous-fractions
  • Nettoyage de ocean slab : il reste uniquement la version avec glace de mer forcé
  • Nouveaux variables pour distiguer la version et type d'ocean : type_ocean=force/slab/couple, version_ocean=opa8/nemo pour couplé ou version_ocean=sicOBS pour slab

JG

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ4/trunk/libf/phylmd/cpl_mod.F90

    r987 r996  
    3232  PRIVATE
    3333
    34   ! All subroutine are public except cpl_send_all and cpl_receive_all
    35   PUBLIC :: cpl_init, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
     34  ! All subroutine are public except cpl_send_all
     35  PUBLIC :: cpl_init, cpl_receive_frac, cpl_receive_ocean_fields, cpl_receive_seaice_fields, &
    3636       cpl_send_ocean_fields, cpl_send_seaice_fields, cpl_send_land_fields, &
    3737       cpl_send_landice_fields, gath2cpl
    … …  
    6868  !$OMP THREADPRIVATE(read_alb_sic)
    6969 
    70 ! fraction for different surface, saved during whole coupling period
    71   REAL, ALLOCATABLE, DIMENSION(:,:), SAVE   :: pctsrf_sav   
    72   !$OMP THREADPRIVATE(pctsrf_sav)
    7370  INTEGER, ALLOCATABLE, DIMENSION(:), SAVE  :: unity
    7471  !$OMP THREADPRIVATE(unity)
    … …  
    8885  !$OMP THREADPRIVATE(cpl_windsp2D)
    8986 
    90 ! variable for OPENMP parallelisation
    91 
     87! variables for OPENMP parallelisation
    9288  INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp
    9389  REAL,ALLOCATABLE,DIMENSION(:,:),SAVE ::  buffer_omp
    … …  
    146142    ALLOCATE(unity(klon), stat = error)
    147143    sum_error = sum_error + error
    148     ALLOCATE(pctsrf_sav(klon,nbsrf), stat = error)
    149     sum_error = sum_error + error
    150144    ALLOCATE(cpl_sols(klon,2), stat = error)
    151145    sum_error = sum_error + error
    … …  
    196190       unity(ig) = ig
    197191    ENDDO
    198     pctsrf_sav = 0.
    199 
    200     cpl_sols = 0.   ; cpl_nsol = 0.  ; cpl_rain = 0.   ; cpl_snow = 0.
    201     cpl_evap = 0.   ; cpl_tsol = 0.  ; cpl_fder = 0.   ; cpl_albe = 0.
    202     cpl_taux = 0.   ; cpl_tauy = 0.  ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0.
    203     cpl_rlic2D = 0. ; cpl_windsp = 0.
     192
     193!    cpl_sols = 0.   ; cpl_nsol = 0.  ; cpl_rain = 0.   ; cpl_snow = 0.
     194!    cpl_evap = 0.   ; cpl_tsol = 0.  ; cpl_fder = 0.   ; cpl_albe = 0.
     195!    cpl_taux = 0.   ; cpl_tauy = 0.  ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0.
     196!    cpl_rlic2D = 0. ; cpl_windsp = 0.
    204197
    205198!*************************************************************************************
    … …  
    262255
    263256!$OMP MASTER
    264   ALLOCATE(knon_omp(0:omp_size-1))
    265   ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
     257    ALLOCATE(knon_omp(0:omp_size-1))
     258    ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))       
    266259!$OMP END MASTER
    267260!$OMP BARRIER
    … …  
    272265!*************************************************************************************
    273266!
    274 
    275   SUBROUTINE cpl_receive_all(itime, dtime, pctsrf)
    276 ! This subroutine reads from coupler for both ocean and seaice
     267 
     268  SUBROUTINE cpl_receive_frac(itime, dtime, pctsrf, is_modified)
     269! This subroutine receives from coupler for both ocean and seaice
    277270! 4 fields : read_sst, read_sic, read_sit and read_alb_sic.
     271! The new sea-ice-land-landice fraction is returned. The others fields
     272! are stored in this module.
     273    USE surface_data
    278274
    279275    INCLUDE "indicesol.h"
    … …  
    283279    INCLUDE "dimensions.h"
    284280
    285 ! Input arguments
     281! Arguments
    286282!************************************************************************************
    287     INTEGER, INTENT(IN)                     :: itime
    288     REAL, INTENT(IN)                        :: dtime
    289     REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
     283    INTEGER, INTENT(IN)                        :: itime
     284    REAL, INTENT(IN)                           :: dtime
     285    REAL, DIMENSION(klon,nbsrf), INTENT(INOUT) :: pctsrf
     286    LOGICAL, INTENT(OUT)                       :: is_modified
    290287
    291288! Local variables
    292289!************************************************************************************
    293     INTEGER                                 :: j, ig, il_time_secs
     290    INTEGER                                 :: j, i, time_sec
    294291    INTEGER                                 :: itau_w
    295292    INTEGER, DIMENSION(iim*(jjm+1))         :: ndexcs
    296     CHARACTER(len = 20)                     :: modname = 'cpl_receive_all'
     293    CHARACTER(len = 20)                     :: modname = 'cpl_receive_frac'
    297294    CHARACTER(len = 80)                     :: abort_message
    298295    REAL, DIMENSION(klon)                   :: read_sic1D
    299     REAL, DIMENSION(iim,jj_nb,jpfldo2a)  :: tab_read_flds
    300     REAL, DIMENSION(iim,jj_nb)           :: read_sic
     296    REAL, DIMENSION(iim,jj_nb,jpfldo2a)     :: tab_read_flds
     297    REAL, DIMENSION(klon,nbsrf)             :: pctsrf_old
    301298
    302299!*************************************************************************************
    … …  
    306303!*************************************************************************************
    307304
     305    is_modified=.FALSE.
     306
     307! Check if right moment to recevie from coupler
     308    IF (MOD(itime, nexca) == 1) THEN
     309       is_modified=.TRUE.
     310 
     311       time_sec=(itime-1)*dtime
    308312#ifdef CPP_COUPLE
    309     il_time_secs=(itime-1)*dtime
    310313!$OMP MASTER
    311     CALL fromcpl(il_time_secs, tab_read_flds)
     314       CALL fromcpl(time_sec, tab_read_flds)
    312315!$OMP END MASTER
    313316#endif
    314317   
    315318! NetCDF output of received fields
    316     IF (is_sequential) THEN
    317        ndexcs(:) = 0
    318        itau_w = itau_phy + itime
    319        DO ig = 1, jpfldo2a
    320           CALL histwrite(nidcs,cl_read(ig),itau_w,tab_read_flds(:,:,ig),iim*(jjm+1),ndexcs)
    321        END DO
    322     ENDIF
    323 
     319       IF (is_sequential) THEN
     320          ndexcs(:) = 0
     321          itau_w = itau_phy + itime
     322          DO i = 1, jpfldo2a
     323             CALL histwrite(nidcs,cl_read(i),itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs)
     324          END DO
     325       ENDIF
     326
     327! Save each field in a 2D array.
    324328!$OMP MASTER
    325 
    326 ! Save each field in a 2D array.
    327 
    328     IF (OPA_version=='OPA9') THEN
    329       read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
    330       read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    331       read_sit(:,:)     = tab_read_flds(:,:,3)  ! Sea ice temperature
    332       read_alb_sic(:,:) = tab_read_flds(:,:,4)  ! Albedo at sea ice
    333     ELSE IF (OPA_version=='OPA8') THEN
    334       read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
    335       read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
    336       read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice
    337       read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature
    338     ELSE
    339       STOP 'Bad OPA version for coupled model'
    340     ENDIF
    341 
    342 !*************************************************************************************
    343 ! Temperature and albedo are weighted with the fraction of sea-ice(read-sic)
    344 !
    345 !*************************************************************************************
    346     DO j = 1, jj_nb
    347        DO ig = 1, iim
    348           IF (ABS(1. - read_sic(ig,j)) < 0.00001) THEN
    349              read_sst(ig,j) = RTT - 1.8
    350              read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
    351              read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
    352           ELSE IF (ABS(read_sic(ig,j)) < 0.00001) THEN
    353              read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
    354              read_sit(ig,j) = read_sst(ig,j)
    355              read_alb_sic(ig,j) =  0.6
    356           ELSE
    357              read_sst(ig,j) = read_sst(ig,j) / (1. - read_sic(ig,j))
    358              read_sit(ig,j) = read_sit(ig,j) / read_sic(ig,j)
    359              read_alb_sic(ig,j) = read_alb_sic(ig,j) / read_sic(ig,j)
     329       IF (version_ocean=='nemo') THEN
     330          read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature
     331          read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
     332          read_sit(:,:)     = tab_read_flds(:,:,3)  ! Sea ice temperature
     333          read_alb_sic(:,:) = tab_read_flds(:,:,4)  ! Albedo at sea ice
     334       ELSE IF (version_ocean=='opa8') THEN
     335          read_sst(:,:)     = tab_read_flds(:,:,1)  ! Sea surface temperature (multiplicated by fraction)
     336          read_sic(:,:)     = tab_read_flds(:,:,2)  ! Sea ice concentration
     337          read_alb_sic(:,:) = tab_read_flds(:,:,3)  ! Albedo at sea ice (multiplicated by fraction)
     338          read_sit(:,:)     = tab_read_flds(:,:,4)  ! Sea ice temperature (multiplicated by fraction)
     339       END IF
     340!$OMP END MASTER
     341
     342!*************************************************************************************
     343!  Transform seaice fraction (read_sic : ocean-seaice mask) into global
     344!  fraction (pctsrf : ocean-seaice-land-landice mask)
     345!
     346!*************************************************************************************
     347       CALL cpl2gath(read_sic, read_sic1D, klon, unity)
     348
     349       pctsrf_old(:,:) = pctsrf(:,:)
     350       DO i = 1, klon
     351          ! treatment only of points with ocean and/or seaice
     352          IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN
     353             pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
     354                  * read_sic1D(i)
     355             pctsrf(i,is_oce) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) &
     356                  - pctsrf(i,is_sic)
    360357          ENDIF
    361358       ENDDO
    362     ENDDO
    363 !$OMP END MASTER
    364 
    365 !*************************************************************************************
    366 !  Transform seaice fraction, read_sic into pctsrf_sav
    367 !
    368 !*************************************************************************************
    369     CALL cpl2gath(read_sic, read_sic1D, klon, unity)
    370 
    371     DO ig = 1, klon
    372        ! treatment only of ocean and/or seaice points
    373        IF (pctsrf(ig,is_oce) > epsfra .OR. &
    374             pctsrf(ig,is_sic) > epsfra) THEN
    375           pctsrf_sav(ig,is_sic) = (pctsrf(ig,is_oce) + pctsrf(ig,is_sic)) &
    376                * read_sic1D(ig)
    377           pctsrf_sav(ig,is_oce) = (pctsrf(ig,is_oce) + pctsrf(ig,is_sic)) &
    378                - pctsrf_sav(ig,is_sic)
    379        ENDIF
    380     ENDDO
    381 
    382 !*************************************************************************************
    383 ! To avoid round up problems
    384 !
    385 !*************************************************************************************
    386     WHERE (ABS(pctsrf_sav(:,is_sic)) .LE. 2.*EPSILON(pctsrf_sav(1,is_sic)))
    387        pctsrf_sav(:,is_sic) = 0.
    388        pctsrf_sav(:,is_oce) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
    389     ENDWHERE
    390     WHERE (ABS(pctsrf_sav(:,is_oce)) .LE. 2.*EPSILON(pctsrf_sav(1,is_oce)))
    391        pctsrf_sav(:,is_sic) = pctsrf(:,is_oce) + pctsrf(:,is_sic)
    392        pctsrf_sav(:,is_oce) = 0.
    393     ENDWHERE
    394     IF (MINVAL(pctsrf_sav(:,is_oce)) < 0.) THEN
    395        WRITE(*,*)'Pb fraction ocean inferieure a 0'
    396        WRITE(*,*)'au point ',MINLOC(pctsrf_sav(:,is_oce))
    397        WRITE(*,*)'valeur = ',MINVAL(pctsrf_sav(:,is_oce))
    398        abort_message = 'voir ci-dessus'
    399        CALL abort_gcm(modname,abort_message,1)
    400     ENDIF
    401     IF (MINVAL(pctsrf_sav(:,is_sic)) < 0.) THEN
    402        WRITE(*,*)'Pb fraction glace inferieure a 0'
    403        WRITE(*,*)'au point ',MINLOC(pctsrf_sav(:,is_sic))
    404        WRITE(*,*)'valeur = ',MINVAL(pctsrf_sav(:,is_sic))
    405        abort_message = 'voir ci-dessus'
    406        CALL abort_gcm(modname,abort_message,1)
    407     ENDIF
    408        
    409   END SUBROUTINE cpl_receive_all
    410 !
    411 !*************************************************************************************
    412 !
    413   SUBROUTINE cpl_receive_ocean_fields(itime, dtime, knon, knindex, pctsrf, &
    414        tsurf_new, pctsrf_oce)
    415 !
    416 ! This routine reads, if first time step in a coupling period, all fields reveived from
    417 ! coupler for all types of surfaces. It returns the fields for the ocean surface which
    418 ! are the sea surface temperature and the fraction of ocean.
    419 ! The fields are transformed into 1D arrays with valid points :
    420 ! tsurf_new(1:knon), pctsrf(1:klon).
     359
     360    END IF ! if time to receive
     361
     362  END SUBROUTINE cpl_receive_frac
     363
     364!
     365!*************************************************************************************
     366!
     367
     368  SUBROUTINE cpl_receive_ocean_fields(knon, knindex, tsurf_new)
     369!
     370! This routine returns the field for the ocean that has been read from the coupler
     371! (done earlier with cpl_receive_frac). The field is the temperature.
     372! The temperature is transformed into 1D array with valid points from index 1 to knon.
    421373!
    422374    INCLUDE "indicesol.h"
    … …  
    424376! Input arguments
    425377!*************************************************************************************
    426     INTEGER, INTENT(IN)                     :: itime
    427     REAL, INTENT(IN)                        :: dtime
    428378    INTEGER, INTENT(IN)                     :: knon
    429379    INTEGER, DIMENSION(klon), INTENT(IN)    :: knindex
    430     REAL, DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf
    431380
    432381! Output arguments
    433382!*************************************************************************************
    434383    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
    435     REAL, DIMENSION(klon), INTENT(OUT)      :: pctsrf_oce
    436 
    437 !*************************************************************************************
    438 ! If first time step in a coupling period receive all fields for all types
    439 ! of surfaces from coupler : read_sst, read_sit, read_alb_sic and pctsrf_sav.
    440 !
    441 !*************************************************************************************
    442 
    443     IF (MOD(itime, nexca) == 1) CALL cpl_receive_all(itime, dtime, pctsrf)
    444 
     384
     385! Local variables
     386!*************************************************************************************
     387    INTEGER               :: i
     388    REAL, DIMENSION(klon) :: sic_new
    445389
    446390!*************************************************************************************
    … …  
    449393!*************************************************************************************
    450394    CALL cpl2gath(read_sst, tsurf_new, knon, knindex)
    451     pctsrf_oce(:) = pctsrf_sav(:,is_oce)
    452 
     395    CALL cpl2gath(read_sic, sic_new, knon, knindex)
     396
     397!*************************************************************************************
     398! The fields received from the coupler have to be weighted with the fraction of ocean
     399! in relation to the total sea-ice+ocean
     400!
     401!*************************************************************************************
     402    DO i=1, knon
     403       tsurf_new(i) = tsurf_new(i)/(1. - sic_new(i))
     404    END DO
    453405
    454406  END SUBROUTINE cpl_receive_ocean_fields
    455 !
    456 !*************************************************************************************
    457 !
     407
     408!
     409!*************************************************************************************
     410!
     411
    458412  SUBROUTINE cpl_receive_seaice_fields(knon, knindex, &
    459        tsurf_new, alb_new, pctsrf_sic)
     413       tsurf_new, alb_new)
    460414!
    461415! This routine returns the fields for the seaice that have been read from the coupler
    462 ! (done earlier with cpl_receive_ocean_fields). These fields are the temperature and
     416! (done earlier with cpl_receive_frac). These fields are the temperature and
    463417! albedo at sea ice surface and fraction of sea ice.
    464 ! The fields are transformed into  1D arrays with valid points :
    465 ! tsurf_new(1:knon), alb_new(1:knon), pctsrf(1:klon).
    466 !
    467     INCLUDE "indicesol.h"
     418! The fields are transformed into 1D arrays with valid points from index 1 to knon.
     419!
    468420
    469421! Input arguments
    … …  
    476428    REAL, DIMENSION(klon), INTENT(OUT)      :: tsurf_new
    477429    REAL, DIMENSION(klon), INTENT(OUT)      :: alb_new
    478     REAL, DIMENSION(klon), INTENT(OUT)      :: pctsrf_sic
    479 
     430
     431! Local variables
     432!*************************************************************************************
     433    INTEGER               :: i
     434    REAL, DIMENSION(klon) :: sic_new
    480435
    481436!*************************************************************************************
    … …  
    485440    CALL cpl2gath(read_sit, tsurf_new, knon, knindex)
    486441    CALL cpl2gath(read_alb_sic, alb_new, knon, knindex)
    487     pctsrf_sic(:) = pctsrf_sav(:,is_sic)
     442    CALL cpl2gath(read_sic, sic_new, knon, knindex)
     443
     444!*************************************************************************************
     445! The fields received from the coupler have to be weighted with the sea-ice
     446! concentration (in relation to the total sea-ice + ocean).
     447!
     448!*************************************************************************************
     449    DO i= 1, knon
     450       tsurf_new(i) = tsurf_new(i) / sic_new(i)
     451       alb_new(i)   = alb_new(i)   / sic_new(i)
     452    END DO
    488453
    489454  END SUBROUTINE cpl_receive_seaice_fields
    … …  
    535500!*************************************************************************************
    536501    IF (MOD(itime, nexca) == 1) THEN
    537        cpl_sols(:,cpl_index) = 0.0
    538        cpl_nsol(:,cpl_index) = 0.0
    539        cpl_rain(:,cpl_index) = 0.0
    540        cpl_snow(:,cpl_index) = 0.0
    541        cpl_evap(:,cpl_index) = 0.0
    542        cpl_tsol(:,cpl_index) = 0.0
    543        cpl_fder(:,cpl_index) = 0.0
    544        cpl_albe(:,cpl_index) = 0.0
    545        cpl_taux(:,cpl_index) = 0.0
    546        cpl_tauy(:,cpl_index) = 0.0
    547        cpl_windsp(:,cpl_index) = 0.0
     502       cpl_sols(1:knon,cpl_index) = 0.0
     503       cpl_nsol(1:knon,cpl_index) = 0.0
     504       cpl_rain(1:knon,cpl_index) = 0.0
     505       cpl_snow(1:knon,cpl_index) = 0.0
     506       cpl_evap(1:knon,cpl_index) = 0.0
     507       cpl_tsol(1:knon,cpl_index) = 0.0
     508       cpl_fder(1:knon,cpl_index) = 0.0
     509       cpl_albe(1:knon,cpl_index) = 0.0
     510       cpl_taux(1:knon,cpl_index) = 0.0
     511       cpl_tauy(1:knon,cpl_index) = 0.0
     512       cpl_windsp(1:knon,cpl_index) = 0.0
    548513    ENDIF
    549514       
    … …  
    709674!*************************************************************************************
    710675    IF (MOD(itime, nexca) == 1) THEN
    711        cpl_sols(:,cpl_index) = 0.0
    712        cpl_nsol(:,cpl_index) = 0.0
    713        cpl_rain(:,cpl_index) = 0.0
    714        cpl_snow(:,cpl_index) = 0.0
    715        cpl_evap(:,cpl_index) = 0.0
    716        cpl_tsol(:,cpl_index) = 0.0
    717        cpl_fder(:,cpl_index) = 0.0
    718        cpl_albe(:,cpl_index) = 0.0
    719        cpl_taux(:,cpl_index) = 0.0
    720        cpl_tauy(:,cpl_index) = 0.0
     676       cpl_sols(1:knon,cpl_index) = 0.0
     677       cpl_nsol(1:knon,cpl_index) = 0.0
     678       cpl_rain(1:knon,cpl_index) = 0.0
     679       cpl_snow(1:knon,cpl_index) = 0.0
     680       cpl_evap(1:knon,cpl_index) = 0.0
     681       cpl_tsol(1:knon,cpl_index) = 0.0
     682       cpl_fder(1:knon,cpl_index) = 0.0
     683       cpl_albe(1:knon,cpl_index) = 0.0
     684       cpl_taux(1:knon,cpl_index) = 0.0
     685       cpl_tauy(1:knon,cpl_index) = 0.0
    721686    ENDIF
    722687       
    … …  
    893858!
    894859    INCLUDE "dimensions.h"
    895    
     860
    896861! Input varibales
    897862!*************************************************************************************
    … …  
    944909! all calculations at the different surfaces have to be done before.
    945910!   
     911    USE surface_data
    946912! Some includes
    947913!*************************************************************************************
    … …  
    962928    INTEGER                                              :: error, sum_error, j
    963929    INTEGER                                              :: itau_w
    964     INTEGER                                              :: il_time_secs
     930    INTEGER                                              :: time_sec
    965931    INTEGER, DIMENSION(iim*(jjm+1))                      :: ndexct
    966932    REAL                                                 :: Up, Down
    … …  
    994960!
    995961!*************************************************************************************
    996 !! AC >>
    997 
    998962!$OMP MASTER
    999     IF (OPA_version=='OPA9') THEN
    1000       tab_flds(:,:,7)  = cpl_windsp2D(:,:)
    1001       tab_flds(:,:,14) = cpl_sols2D(:,:,2)
    1002       tab_flds(:,:,12) = cpl_sols2D(:,:,1)
    1003       tab_flds(:,:,15) = cpl_nsol2D(:,:,2)
    1004       tab_flds(:,:,13) = cpl_nsol2D(:,:,1)
    1005       tab_flds(:,:,16) = cpl_fder2D(:,:,2)
    1006       tab_flds(:,:,11) = cpl_evap2D(:,:,2)
    1007       tab_flds(:,:,18) = cpl_rriv2D(:,:)
    1008       tab_flds(:,:,19) = cpl_rcoa2D(:,:)
    1009     ELSE IF (OPA_version=='OPA8') THEN
    1010       tab_flds(:,:,7)  = cpl_windsp2D(:,:)
    1011       tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
    1012       tab_flds(:,:,9)  = cpl_sols2D(:,:,1)
    1013       tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
    1014       tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
    1015       tab_flds(:,:,12) = cpl_fder2D(:,:,2)
    1016       tab_flds(:,:,13) = cpl_evap2D(:,:,2)
    1017       tab_flds(:,:,14) = cpl_evap2D(:,:,1)
    1018       tab_flds(:,:,17) = cpl_rcoa2D(:,:)
    1019       tab_flds(:,:,18) = cpl_rriv2D(:,:)
    1020     ELSE
    1021       STOP 'Bad OPA version for coupled model'
    1022     ENDIF
    1023 
     963    IF (version_ocean=='nemo') THEN
     964       tab_flds(:,:,7)  = cpl_windsp2D(:,:)
     965       tab_flds(:,:,14) = cpl_sols2D(:,:,2)
     966       tab_flds(:,:,12) = cpl_sols2D(:,:,1)
     967       tab_flds(:,:,15) = cpl_nsol2D(:,:,2)
     968       tab_flds(:,:,13) = cpl_nsol2D(:,:,1)
     969       tab_flds(:,:,16) = cpl_fder2D(:,:,2)
     970       tab_flds(:,:,11) = cpl_evap2D(:,:,2)
     971       tab_flds(:,:,18) = cpl_rriv2D(:,:)
     972       tab_flds(:,:,19) = cpl_rcoa2D(:,:)
     973    ELSE IF (version_ocean=='opa8') THEN
     974       tab_flds(:,:,7)  = cpl_windsp2D(:,:)
     975       tab_flds(:,:,8)  = cpl_sols2D(:,:,2)
     976       tab_flds(:,:,9)  = cpl_sols2D(:,:,1)
     977       tab_flds(:,:,10) = cpl_nsol2D(:,:,2)
     978       tab_flds(:,:,11) = cpl_nsol2D(:,:,1)
     979       tab_flds(:,:,12) = cpl_fder2D(:,:,2)
     980       tab_flds(:,:,13) = cpl_evap2D(:,:,2)
     981       tab_flds(:,:,14) = cpl_evap2D(:,:,1)
     982       tab_flds(:,:,17) = cpl_rcoa2D(:,:)
     983       tab_flds(:,:,18) = cpl_rriv2D(:,:)
     984    END IF
     985   
    1024986!*************************************************************************************
    1025987! Transform the fraction of sub-surfaces from 1D to 2D array
    … …  
    1028990    pctsrf2D(:,:,:) = 0.
    1029991!$OMP END MASTER
    1030 
    1031992    CALL gath2cpl(pctsrf(:,is_oce), pctsrf2D(:,:,is_oce), klon, unity)
    1032993    CALL gath2cpl(pctsrf(:,is_sic), pctsrf2D(:,:,is_sic), klon, unity)
    … …  
    10401001    IF (is_omp_root) THEN
    10411002
    1042       DO j = 1, jj_nb
    1043          tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
    1044               pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
    1045       ENDDO
    1046    
    1047    
    1048       IF (is_parallel) THEN
     1003       DO j = 1, jj_nb
     1004          tmp_calv(:,j) = DOT_PRODUCT (cpl_rlic2D(1:iim,j), &
     1005               pctsrf2D(1:iim,j,is_lic)) / REAL(iim)
     1006       ENDDO
     1007       
     1008   
     1009       IF (is_parallel) THEN
    10491010         IF (.NOT. is_north_pole) THEN
    10501011#ifdef CPP_PARA
    … …  
    10531014#endif
    10541015         ENDIF
    1055        
     1016          
    10561017         IF (.NOT. is_south_pole) THEN
    10571018#ifdef CPP_PARA
    … …  
    10601021#endif
    10611022         ENDIF
    1062        
     1023        
    10631024         IF (.NOT. is_north_pole .AND. ii_begin /=1) THEN
    10641025            Up=Up+tmp_calv(iim,1)
    10651026            tmp_calv(:,1)=Up
    10661027         ENDIF
    1067        
     1028        
    10681029         IF (.NOT. is_south_pole .AND. ii_end /= iim) THEN
    10691030            Down=Down+tmp_calv(1,jj_nb)
    … …  
    10711032         ENDIF
    10721033      ENDIF
    1073        
    1074       IF (OPA_version=='OPA9') THEN
    1075         tab_flds(:,:,17) = tmp_calv(:,:)
    1076       ELSE IF (OPA_version=='OPA8') THEN
    1077         tab_flds(:,:,17) = tmp_calv(:,:)
    1078       ELSE
    1079         STOP 'Bad OPA version for coupled model'
    1080       ENDIF
    1081 
     1034     
     1035      IF (version_ocean=='nemo') THEN
     1036         tab_flds(:,:,17) = tmp_calv(:,:)
     1037      ELSE IF (version_ocean=='opa8') THEN
     1038         tab_flds(:,:,19) = tmp_calv(:,:)
     1039      END IF
    10821040
    10831041!*************************************************************************************
    … …  
    10891047!
    10901048!*************************************************************************************   
    1091       ! fraction oce+seaice
    1092       deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
    1093 
    1094       IF (OPA_version=='OPA9') THEN
    1095 
    1096         tab_flds(:,:,10) = 0.0
    1097         tmp_taux(:,:)    = 0.0
    1098         tmp_tauy(:,:)    = 0.0
    1099         ! fraction oce+seaice
    1100         ! For all valid grid cells containing some fraction of ocean or sea-ice
    1101         WHERE ( deno(:,:) /= 0 )
    1102            tab_flds(:,:,10) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1103                               cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1104 
    1105            tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1106                       cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1107            tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1108                       cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1109         ENDWHERE
    1110         tab_flds(:,:,8) = (cpl_evap2D(:,:,1) - ( cpl_rain2D(:,:,1) + cpl_snow2D(:,:,1)))
    1111         tab_flds(:,:,9) = (cpl_evap2D(:,:,2) - ( cpl_rain2D(:,:,2) + cpl_snow2D(:,:,2)))
    1112 
    1113       ELSE IF (OPA_version=='OPA8') THEN
    1114 
    1115         tab_flds(:,:,15) = 0.0
    1116         tab_flds(:,:,16) = 0.0
    1117         tmp_taux(:,:)    = 0.0
    1118         tmp_tauy(:,:)    = 0.0
    1119         ! For all valid grid cells containing some fraction of ocean or sea-ice
    1120         WHERE ( deno(:,:) /= 0 )
    1121            tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1122                               cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1123            tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1124                               cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1125        
    1126            tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1127                       cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1128            tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
    1129                       cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
    1130         ENDWHERE
    1131 
    1132       ELSE
    1133         STOP 'Bad OPA version for coupled model'
    1134       ENDIF
    1135    
    1136     ENDIF ! is_omp_root 
    1137 
    1138 
    1139 ! AC <<
     1049       ! fraction oce+seaice
     1050       deno =  pctsrf2D(:,:,is_oce) + pctsrf2D(:,:,is_sic)
     1051
     1052       IF (version_ocean=='nemo') THEN
     1053          tab_flds(:,:,10) = 0.0
     1054          tmp_taux(:,:)    = 0.0
     1055          tmp_tauy(:,:)    = 0.0
     1056          ! For all valid grid cells containing some fraction of ocean or sea-ice
     1057          WHERE ( deno(:,:) /= 0 )
     1058             tab_flds(:,:,10) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1059                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1060             
     1061             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1062                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1063             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1064                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1065          ENDWHERE
     1066          tab_flds(:,:,8) = (cpl_evap2D(:,:,1) - ( cpl_rain2D(:,:,1) + cpl_snow2D(:,:,1)))
     1067          tab_flds(:,:,9) = (cpl_evap2D(:,:,2) - ( cpl_rain2D(:,:,2) + cpl_snow2D(:,:,2)))
     1068         
     1069       ELSE IF (version_ocean=='opa8') THEN
     1070          tab_flds(:,:,15) = 0.0
     1071          tab_flds(:,:,16) = 0.0
     1072          tmp_taux(:,:)    = 0.0
     1073          tmp_tauy(:,:)    = 0.0
     1074          ! For all valid grid cells containing some fraction of ocean or sea-ice
     1075          WHERE ( deno(:,:) /= 0 )
     1076             tab_flds(:,:,15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1077                  cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1078             tab_flds(:,:,16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1079                  cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1080             
     1081             tmp_taux = cpl_taux2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1082                  cpl_taux2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1083             tmp_tauy = cpl_tauy2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) +    &
     1084                  cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:)
     1085          ENDWHERE
     1086       END IF
     1087
     1088    ENDIF ! is_omp_root
     1089 
    11401090!*************************************************************************************
    11411091! Transform the wind components from local atmospheric 2D coordinates to geocentric
    … …  
    11451095
    11461096! Transform the longitudes and latitudes on 2D arrays
    1147    
    11481097    CALL gather_omp(rlon,rlon_mpi)
    11491098    CALL gather_omp(rlat,rlat_mpi)
    … …  
    12111160!
    12121161!*************************************************************************************
     1162    time_sec=(itime-1)*dtime
    12131163#ifdef CPP_COUPLE
    1214     il_time_secs=(itime-1)*dtime
    12151164!$OMP MASTER
    1216     CALL intocpl(il_time_secs, lafin, tab_flds(:,:,:))
     1165    CALL intocpl(time_sec, lafin, tab_flds(:,:,:))
    12171166!$OMP END MASTER
    12181167#endif
    … …  
    12391188!
    12401189  SUBROUTINE cpl2gath(champ_in, champ_out, knon, knindex)
    1241   USE mod_phys_lmdz_para
     1190    USE mod_phys_lmdz_para
    12421191! Cette routine ecrit un champ 'gathered' sur la grille 2D pour le passer
    12431192! au coupleur.
    … …  
    12691218!*************************************************************************************
    12701219!
    1271    
    1272 
    12731220! Transform from 2 dimensions (iim,jj_nb) to 1 dimension (klon)
    12741221!$OMP MASTER
    … …  
    12831230       champ_out(i) = temp_omp(ig)
    12841231    ENDDO
    1285  
    12861232   
    12871233  END SUBROUTINE cpl2gath
Note: See TracChangeset for help on using the changeset viewer.