Changeset 272

Timestamp:

2011-06-20T15:28:40+02:00 (13 years ago)

Author:

didier.solyga

Message:

Correct forcesoil.f90 and teststomate.f90 for working with the externalized version (branche ORCHIDEE_EXT)

Location:

branches/ORCHIDEE_EXT/ORCHIDEE_OL

Files:

• forcesoil.f90 (modified) (4 diffs)
• teststomate.f90 (modified) (7 diffs)

branches/ORCHIDEE_EXT/ORCHIDEE_OL/forcesoil.f90

@@ -73 +73 @@
   REAL(r_std),ALLOCATABLE :: carbon_loc(:,:,:)
   INTEGER :: ierr
+  !>> DS add for externalization
+  LOGICAL  :: l_error
+  ! >> DS
 
   CALL Init_para(.FALSE.) 
 
-  CALL getin_p('NVM',nvm)
+  !
+  ! DS : For externalization cause we decoupled forcesoil from ORCHIDEE
+  !
+  
+  ! 1. Read the number of PFTs
+  CALL getin('NVM',nvm)
+  ! 2. Allocation
+  l_error = .FALSE.
+  ALLOCATE(pft_to_mtc(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  IF (l_error) THEN
+     STOP 'pft_to_mtc (forcesoil only) : error in memory allocation'
+  ENDIF
+
+  ! 3. Initialisation of the correspondance table
+  pft_to_mtc (:) = undef_integer
+  
+  ! 4.Reading of the conrrespondance table in the .def file
+  CALL getin('PFT_TO_MTC',pft_to_mtc)
+
+  ! 4.1 if nothing is found, we use the standard configuration
+  IF(nvm .EQ. 13 ) THEN
+     IF(pft_to_mtc(1) .EQ. undef_integer) THEN
+        WRITE(numout,*) 'Note to the user : we will use ORCHIDEE to its standard configuration'
+        pft_to_mtc(:) = (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13 /)
+     ENDIF
+  ELSE   
+     IF(pft_to_mtc(1) .EQ. undef_integer) THEN
+        WRITE(numout,*)' The array PFT_TO_MTC is empty : we stop'
+     ENDIF
+  ENDIF
+  
+  ! 5. What happened if pft_to_mtc(j) > nvmc (if the mtc doesn't exist)?
+  DO i = 1, nvm
+     IF(pft_to_mtc(i) .GT. nvmc) THEN
+        WRITE(numout,*) "the MTC you chose doesn't exist"
+        STOP 'we stop reading pft_to_mtc'
+     ENDIF
+  ENDDO
+  
+  
+  ! 6. Check if pft_to_mtc(1) = 1 
+  IF(pft_to_mtc(1) .NE. 1) THEN
+     WRITE(numout,*) 'the first pft has to be the bare soil'
+     STOP 'we stop reading next values of pft_to_mtc'
+  ELSE
+     DO i = 2,nvm
+        IF(pft_to_mtc(i) .EQ.1) THEN
+           WRITE(numout,*) 'only pft_to_mtc(1) has to be the bare soil'
+           STOP 'we stop reading pft_to_mtc'
+        ENDIF
+     ENDDO
+  ENDIF
+  
+
+  ! 7. Allocate and initialize natural ans is_c4
+  
+  ! 7.1 Memory allocation
+  l_error = .FALSE.
+  ALLOCATE(natural(nvm),stat=ier)
+  l_error = l_error .OR. (ier .NE. 0)
+  ALLOCATE(is_c4(nvm),stat=ier)
+
+  IF (l_error) THEN
+     STOP 'natural or is_c4 (forcesoil only) : error in memory allocation'
+  ENDIF
+
+  ! 7.2 Initialisation
+  DO j= 1, nvm
+     natural(j) = natural_mtc(pft_to_mtc(j))
+     is_c4(j) = is_c4_mtc(pft_to_mtc(j))
+  ENDDO
+
   !-
   ! Stomate's restart files
@@ -112 +187 @@
   !-
   CALL bcast(date0)
-!!! MM : Ã  revoir : choix du calendrier dans forcesoil ?? Il est dans le restart de stomate !
+!!! MM : à revoir : choix du calendrier dans forcesoil ?? Il est dans le restart de stomate !
   !  CALL ioconf_calendar ('noleap')
   CALL ioget_calendar  (one_year,one_day)
@@ -218 +293 @@
         IF (m<10) part_str(1:1)='0'
         var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
-        CALL restget &
+        CALL restget_p &
              &    (rest_id_sto, var_name, kjpindex, ncarb , 1, itau_dep, &
              &     .TRUE., carbon(:,:,m), 'gather', kjpindex, indices)
@@ -325 +400 @@
         IF (m<10) part_str(1:1)='0'
         var_name = 'carbon_'//part_str(1:LEN_TRIM(part_str))
-        CALL restput &
+        CALL restput_p &
              &    (rest_id_sto, var_name, kjpindex, ncarb , 1, itau_dep, &
              &     carbon(:,:,m), 'scatter', kjpindex, indices)

branches/ORCHIDEE_EXT/ORCHIDEE_OL/teststomate.f90

@@ -53 +53 @@
   REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: qsintmax_x
   REAL(r_std),DIMENSION(:,:),ALLOCATABLE    :: co2_flux
-!!$   DS add for externalised version
+!!$ >>  DS add for externalised version
   REAL(r_std),DIMENSION(:),ALLOCATABLE      :: hist_PFTaxis
-!!$   DS
+!!$ >>  DS
 
 
@@ -75 +75 @@
   CHARACTER(LEN=30)                :: time_str
   REAL                             :: hist_days_stom,hist_dt_stom
-!!$  REAL,DIMENSION(nvm)              :: hist_PFTaxis
   REAL(r_std),DIMENSION(10)         :: hist_pool_10axis     
   REAL(r_std),DIMENSION(100)        :: hist_pool_100axis     
@@ -176 +175 @@
   write(*,*) 'ATTENTION',dtradia,dt_force
 
-!!$ DS added for the externalised version
-!!$we need to know the pft parameters values used for stomate
+!!$ >> DS added for the externalised version
+!!$ we need to know the pft parameters values used for stomate
+
+  ! 1. Read the number of PFTs
+  CALL getin('NVM',nvm)
+  ! 2. Allocate and read the pft parameters stomate specific
   CALL pft_parameters_main
   CALL getin_stomate_pft_parameters
@@ -186 +189 @@
 !-
   a_er = .FALSE.
-!!$ DS added for the externalised version
-!!$  ALLOCATE (pft_to_mtc(nvm),stat=ier)
-!!$  a_er = a_er .OR. (ier.NE.0) 
+!!$ >> DS added for the externalised version
   ALLOCATE (hist_PFTaxis(nvm),stat=ier)
   a_er = a_er .OR. (ier.NE.0)
@@ -356 +357 @@
   control%ok_co2 = .TRUE.
   control%ok_stomate = .TRUE.
-!!$DS now we search the values for the scalar parameters in orchidee.def
+!!$ >> DS now we search the values for the scalar parameters in  some .def files
   CALL getin_co2_parameters
   CALL getin_stomate_parameters
-!!$  CALL getin('CLAYFRACTION_DEFAULT',clayfraction_default)
+!!$ >> DS 
 !-
 ! is DGVM activated?
@@ -366 +367 @@
   CALL getin('STOMATE_OK_DGVM',control%ok_dgvm)
   WRITE(*,*) 'LPJ is activated: ',control%ok_dgvm
-!!$DS for the externalisation reading the scalar parameters when ok_dgvm is set to true
+!!$ >> DS for the externalisation reading the scalar parameters when ok_dgvm is set to true
   IF (control%ok_dgvm) THEN 
      CALL getin_dgvm_parameters   
   ENDIF
+!!$ >> DS 
 !-
 ! restart files
@@ -542 +544 @@
 !-
   
-  ! DS : getin the value of slowproc parameters
+  ! >> DS : getin the value of slowproc parameters
   CALL getin('CLAYFRACTION_DEFAULT',clayfraction_default)
+  CALL getin('SOILTYPE_DEFAULT',soiltype_default)
+  ! >> DS
 
   CALL slowproc_main &