Changeset 272 for branches/ORCHIDEE_EXT/ORCHIDEE_OL/forcesoil.f90

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)

File:

• branches/ORCHIDEE_EXT/ORCHIDEE_OL/forcesoil.f90 (modified) (4 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)