Changeset 1152
- Timestamp:
- Apr 29, 2009, 5:00:54 PM (15 years ago)
- Location:
- LMDZ4/branches/LMDZ4-dev/libf/phylmd
- Files:
-
- 2 edited
-
cpl_mod.F90 (modified) (28 diffs)
-
oasis.F90 (modified) (20 diffs)
Legend:
- Unmodified
- Added
- Removed
-
LMDZ4/branches/LMDZ4-dev/libf/phylmd/cpl_mod.F90
r1133 r1152 51 51 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp 52 52 !$OMP THREADPRIVATE(cpl_windsp) 53 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co2 54 !$OMP THREADPRIVATE(cpl_atm_co2) 53 55 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_tauy 54 56 !$OMP THREADPRIVATE(cpl_tauy) … … 67 69 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_u0, read_v0 ! ocean surface current 68 70 !$OMP THREADPRIVATE(read_u0,read_v0) 69 71 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: read_co2 ! ocean co2 flux 72 !$OMP THREADPRIVATE(read_co2) 70 73 INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: unity 71 74 !$OMP THREADPRIVATE(unity) … … 84 87 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_windsp2D 85 88 !$OMP THREADPRIVATE(cpl_windsp2D) 86 87 ! variable for OPENMP parallelisation 88 89 INTEGER,ALLOCATABLE,DIMENSION(:),SAVE :: knon_omp 90 REAL,ALLOCATABLE,DIMENSION(:,:),SAVE :: buffer_omp 91 89 REAL, ALLOCATABLE, DIMENSION(:,:), SAVE :: cpl_atm_co22D 90 !$OMP THREADPRIVATE(cpl_atm_co22D) 91 92 92 CONTAINS 93 93 ! … … 178 178 ALLOCATE(read_alb_sic(iim, jj_nb), stat = error) 179 179 sum_error = sum_error + error 180 181 180 ALLOCATE(read_u0(iim, jj_nb), stat = error) 182 181 sum_error = sum_error + error 183 182 ALLOCATE(read_v0(iim, jj_nb), stat = error) 184 183 sum_error = sum_error + error 184 185 IF (cpl_carbon_cycle) THEN 186 ALLOCATE(read_co2(iim, jj_nb), stat = error) 187 sum_error = sum_error + error 188 ALLOCATE(cpl_atm_co2(klon,2), stat = error) 189 sum_error = sum_error + error 190 END IF 185 191 186 192 IF (sum_error /= 0) THEN … … 195 201 unity(ig) = ig 196 202 ENDDO 197 198 ! cpl_sols = 0. ; cpl_nsol = 0. ; cpl_rain = 0. ; cpl_snow = 0.199 ! cpl_evap = 0. ; cpl_tsol = 0. ; cpl_fder = 0. ; cpl_albe = 0.200 ! cpl_taux = 0. ; cpl_tauy = 0. ; cpl_rriv2D = 0. ; cpl_rcoa2D = 0.201 ! cpl_rlic2D = 0. ; cpl_windsp = 0.202 203 203 204 !************************************************************************************* … … 237 238 CALL histdef(nidct, 'tmp_lat','tmp_lat', & 238 239 "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) 239 DO jf=1,jpflda2o1 + jpflda2o2 240 CALL histdef(nidct, cl_writ(jf),cl_writ(jf), & 241 "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) 240 DO jf=1,maxsend 241 IF (infosend(i)%action) THEN 242 CALL histdef(nidct, infosend(i)%name ,infosend(i)%name , & 243 "-",iim, jjm+1, nhoridct, 1, 1, 1, -99, 32, "inst", dtime,dtime) 244 ENDIF 242 245 END DO 243 246 CALL histend(nidct) … … 248 251 0,zjulian,dtime,nhoridcs,nidcs) 249 252 ! no vertical axis 250 DO jf=1,jpfldo2a 251 CALL histdef(nidcs, cl_read(jf),cl_read(jf), & 252 "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime) 253 DO jf=1,maxrecv 254 IF (inforecv(i)%action) THEN 255 CALL histdef(nidcs,inforecv(i)%name ,inforecv(i)%name , & 256 "-",iim, jjm+1, nhoridcs, 1, 1, 1, -99, 32, "inst", dtime,dtime) 257 ENDIF 253 258 END DO 254 259 CALL histend(nidcs) … … 256 261 257 262 ENDIF ! is_sequential 258 259 ! OPENMP Initialization260 261 !$OMP MASTER262 ALLOCATE(knon_omp(0:omp_size-1))263 ALLOCATE(buffer_omp(klon_mpi,0:omp_size-1))264 !$OMP END MASTER265 !$OMP BARRIER266 263 267 264 END SUBROUTINE cpl_init … … 300 297 CHARACTER(len = 80) :: abort_message 301 298 REAL, DIMENSION(klon) :: read_sic1D 302 REAL, DIMENSION(iim,jj_nb, jpfldo2a):: tab_read_flds299 REAL, DIMENSION(iim,jj_nb,maxrecv) :: tab_read_flds 303 300 REAL, DIMENSION(klon,nbsrf) :: pctsrf_old 304 301 REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi … … 329 326 ndexcs(:) = 0 330 327 itau_w = itau_phy + itime 331 DO i = 1, jpfldo2a 332 CALL histwrite(nidcs,cl_read(i),itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs) 328 DO i = 1, maxrecv 329 IF (inforecv(i)%action) THEN 330 CALL histwrite(nidcs,inforecv(i)%name,itau_w,tab_read_flds(:,:,i),iim*(jjm+1),ndexcs) 331 ENDIF 333 332 END DO 334 333 ENDIF … … 337 336 ! Save each field in a 2D array. 338 337 !$OMP MASTER 339 read_sst(:,:) = tab_read_flds(:,:, 1) ! Sea surface temperature340 read_sic(:,:) = tab_read_flds(:,:, 2) ! Sea ice concentration341 read_alb_sic(:,:) = tab_read_flds(:,:, 3) ! Albedo at sea ice342 read_sit(:,:) = tab_read_flds(:,:, 4) ! Sea ice temperature338 read_sst(:,:) = tab_read_flds(:,:,idr_sisutw) ! Sea surface temperature 339 read_sic(:,:) = tab_read_flds(:,:,idr_icecov) ! Sea ice concentration 340 read_alb_sic(:,:) = tab_read_flds(:,:,idr_icealw) ! Albedo at sea ice 341 read_sit(:,:) = tab_read_flds(:,:,idr_icetem) ! Sea ice temperature 343 342 !$OMP END MASTER 344 343 … … 354 353 ! Transform the currents from cartesian to spheric coordinates 355 354 ! tmp_r0 should be zero 356 CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,5), tab_read_flds(:,:,6), tab_read_flds(:,:,7), & 355 CALL geo2atm(iim, jj_nb, tab_read_flds(:,:,idr_curenx), & 356 tab_read_flds(:,:,idr_cureny), tab_read_flds(:,:,idr_curenz), & 357 357 tmp_lon, tmp_lat, & 358 358 read_u0(:,:), read_v0(:,:), tmp_r0(:,:)) 359 359 !$OMP END MASTER 360 360 361 361 ELSE 362 362 read_u0(:,:) = 0. 363 363 read_v0(:,:) = 0. 364 ENDIF 365 366 IF (cpl_carbon_cycle) THEN 367 !$OMP MASTER 368 read_co2(:,:) = tab_read_flds(:,:,idr_oceco2) ! CO2 flux 369 !$OMP END MASTER 364 370 ENDIF 365 371 … … 374 380 DO i = 1, klon 375 381 ! treatment only of points with ocean and/or seaice 382 ! old land-ocean mask can not be changed 376 383 IF (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic) > 0.) THEN 377 384 pctsrf(i,is_sic) = (pctsrf_old(i,is_oce) + pctsrf_old(i,is_sic)) & … … 423 430 CALL cpl2gath(read_v0, v0_new, knon, knindex) 424 431 432 IF (cpl_carbon_cycle) THEN 433 WRITE(*,*) 'cpl_carbon_cycle TO BE DONE!!' 434 !! var_co2 will be a intent(out) argument 435 !! CALL cpl2gath(read_co2, var_co2, knon, knindex) 436 END IF 425 437 !************************************************************************************* 426 438 ! The fields received from the coupler have to be weighted with the fraction of ocean … … 519 531 CHARACTER(len = 25) :: modname = 'cpl_send_ocean_fields' 520 532 CHARACTER(len = 80) :: abort_message 533 REAL, DIMENSION(klon) :: atm_co2 ! JG: to be an INTENT(IN) if cpl_carbon_cycle 521 534 522 535 !************************************************************************************* … … 543 556 cpl_tauy(1:knon,cpl_index) = 0.0 544 557 cpl_windsp(1:knon,cpl_index) = 0.0 558 IF (cpl_carbon_cycle) cpl_atm_co2(1:knon,cpl_index) = 0.0 545 559 ENDIF 546 560 … … 572 586 cpl_windsp(ig,cpl_index) = cpl_windsp(ig,cpl_index) + & 573 587 windsp(ig) / FLOAT(nexca) 574 ENDDO 588 589 IF (cpl_carbon_cycle) THEN 590 atm_co2=286. 591 cpl_atm_co2(ig,cpl_index) = cpl_atm_co2(ig,cpl_index) + & 592 atm_co2(ig)/ FLOAT(nexca) 593 END IF 594 ENDDO 575 595 576 596 !************************************************************************************* … … 607 627 sum_error = sum_error + error 608 628 629 IF (cpl_carbon_cycle) THEN 630 ALLOCATE(cpl_atm_co22D(iim,jj_nb), stat=error) 631 sum_error = sum_error + error 632 END IF 633 609 634 IF (sum_error /= 0) THEN 610 635 abort_message='Pb allocation variables couplees pour l''ecriture' … … 650 675 knon, knindex) 651 676 652 ENDIF 677 IF (cpl_carbon_cycle) & 678 CALL gath2cpl(cpl_atm_co2(:,cpl_index), cpl_atm_co22D(:,:), knon, knindex) 679 ENDIF 653 680 654 681 END SUBROUTINE cpl_send_ocean_fields … … 775 802 ALLOCATE(cpl_windsp2D(iim,jj_nb), stat=error) 776 803 sum_error = sum_error + error 777 804 805 IF (cpl_carbon_cycle) THEN 806 ALLOCATE(cpl_atm_co22D(iim,jj_nb), stat=error) 807 sum_error = sum_error + error 808 END IF 809 778 810 IF (sum_error /= 0) THEN 779 811 abort_message='Pb allocation variables couplees pour l''ecriture' … … 979 1011 REAL, DIMENSION(iim, jj_nb) :: tmp_calv 980 1012 ! Table with all fields to send to coupler 981 REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2):: tab_flds1013 REAL, DIMENSION(iim, jj_nb, maxsend) :: tab_flds 982 1014 REAL, DIMENSION(klon_mpi) :: rlon_mpi, rlat_mpi 983 1015 … … 998 1030 !************************************************************************************* 999 1031 !$OMP MASTER 1000 tab_flds(:,:, 7)= cpl_windsp2D(:,:)1001 tab_flds(:,:, 8)= cpl_sols2D(:,:,2)1002 tab_flds(:,:, 10) = cpl_nsol2D(:,:,2)1003 tab_flds(:,:, 12) = cpl_fder2D(:,:,2)1032 tab_flds(:,:,ids_windsp) = cpl_windsp2D(:,:) 1033 tab_flds(:,:,ids_shfice) = cpl_sols2D(:,:,2) 1034 tab_flds(:,:,ids_nsfice) = cpl_nsol2D(:,:,2) 1035 tab_flds(:,:,ids_dflxdt) = cpl_fder2D(:,:,2) 1004 1036 1005 1037 IF (version_ocean=='nemo') THEN 1006 tab_flds(:,:,18) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) 1038 tab_flds(:,:,ids_liqrun) = cpl_rriv2D(:,:) + cpl_rcoa2D(:,:) 1039 IF (cpl_carbon_cycle) tab_flds(:,:,ids_atmco2)=cpl_atm_co22D(:,:) 1007 1040 ELSE IF (version_ocean=='opa8') THEN 1008 tab_flds(:,:, 9)= cpl_sols2D(:,:,1)1009 tab_flds(:,:, 11) = cpl_nsol2D(:,:,1)1010 tab_flds(:,:, 13) = cpl_evap2D(:,:,2)1011 tab_flds(:,:, 14) = cpl_evap2D(:,:,1)1012 tab_flds(:,:, 17) = cpl_rcoa2D(:,:)1013 tab_flds(:,:, 18) = cpl_rriv2D(:,:)1041 tab_flds(:,:,ids_shfoce) = cpl_sols2D(:,:,1) 1042 tab_flds(:,:,ids_nsfoce) = cpl_nsol2D(:,:,1) 1043 tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) 1044 tab_flds(:,:,ids_ocevap) = cpl_evap2D(:,:,1) 1045 tab_flds(:,:,ids_runcoa) = cpl_rcoa2D(:,:) 1046 tab_flds(:,:,ids_rivflu) = cpl_rriv2D(:,:) 1014 1047 END IF 1015 1048 … … 1063 1096 ENDIF 1064 1097 1065 IF (version_ocean=='nemo') THEN 1066 tab_flds(:,:,17) = tmp_calv(:,:) 1067 ELSE IF (version_ocean=='opa8') THEN 1068 tab_flds(:,:,19) = tmp_calv(:,:) 1069 END IF 1098 tab_flds(:,:,ids_calvin) = tmp_calv(:,:) 1070 1099 1071 1100 !************************************************************************************* … … 1078 1107 1079 1108 IF (version_ocean=='nemo') THEN 1080 tab_flds(:,:, 9) = 0.01081 tab_flds(:,:, 11) = 0.01082 tab_flds(:,:, 13) = 0.01083 tab_flds(:,:, 14) = 0.01084 tab_flds(:,:, 15) = 0.01109 tab_flds(:,:,ids_shftot) = 0.0 1110 tab_flds(:,:,ids_nsftot) = 0.0 1111 tab_flds(:,:,ids_totrai) = 0.0 1112 tab_flds(:,:,ids_totsno) = 0.0 1113 tab_flds(:,:,ids_toteva) = 0.0 1085 1114 1086 1115 tmp_taux(:,:) = 0.0 … … 1093 1122 cpl_tauy2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1094 1123 1095 tab_flds(:,:, 9) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1124 tab_flds(:,:,ids_shftot) = cpl_sols2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1096 1125 cpl_sols2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1097 tab_flds(:,:, 11) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1126 tab_flds(:,:,ids_nsftot) = cpl_nsol2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1098 1127 cpl_nsol2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1099 tab_flds(:,:, 13) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1128 tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1100 1129 cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1101 tab_flds(:,:, 14) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1130 tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1102 1131 cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1103 tab_flds(:,:, 15) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1132 tab_flds(:,:,ids_toteva) = cpl_evap2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1104 1133 cpl_evap2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1105 1134 ENDWHERE 1106 1135 1107 tab_flds(:,:, 16) = cpl_evap2D(:,:,2)1136 tab_flds(:,:,ids_icevap) = cpl_evap2D(:,:,2) 1108 1137 1109 1138 ELSE IF (version_ocean=='opa8') THEN 1110 1139 ! Store fields for rain and snow in tab_flds(:,:,15) and tab_flds(:,:,16) 1111 tab_flds(:,:, 15) = 0.01112 tab_flds(:,:, 16) = 0.01140 tab_flds(:,:,ids_totrai) = 0.0 1141 tab_flds(:,:,ids_totsno) = 0.0 1113 1142 tmp_taux(:,:) = 0.0 1114 1143 tmp_tauy(:,:) = 0.0 1115 1144 ! For all valid grid cells containing some fraction of ocean or sea-ice 1116 1145 WHERE ( deno(:,:) /= 0 ) 1117 tab_flds(:,:, 15) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1146 tab_flds(:,:,ids_totrai) = cpl_rain2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1118 1147 cpl_rain2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1119 tab_flds(:,:, 16) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + &1148 tab_flds(:,:,ids_totsno) = cpl_snow2D(:,:,1) * pctsrf2D(:,:,is_oce) / deno(:,:) + & 1120 1149 cpl_snow2D(:,:,2) * pctsrf2D(:,:,is_sic) / deno(:,:) 1121 1150 … … 1163 1192 !$OMP MASTER 1164 1193 CALL atm2geo (iim, jj_nb, tmp_taux, tmp_tauy, tmp_lon, tmp_lat, & 1165 tab_flds(:,:, 1), tab_flds(:,:,2), tab_flds(:,:,3) )1166 1167 tab_flds(:,:, 4) = tab_flds(:,:,1)1168 tab_flds(:,:, 5) = tab_flds(:,:,2)1169 tab_flds(:,:, 6) = tab_flds(:,:,3)1194 tab_flds(:,:,ids_tauxxu), tab_flds(:,:,ids_tauyyu), tab_flds(:,:,ids_tauzzu) ) 1195 1196 tab_flds(:,:,ids_tauxxv) = tab_flds(:,:,ids_tauxxu) 1197 tab_flds(:,:,ids_tauyyv) = tab_flds(:,:,ids_tauyyu) 1198 tab_flds(:,:,ids_tauzzv) = tab_flds(:,:,ids_tauzzu) 1170 1199 !$OMP END MASTER 1171 1200 … … 1175 1204 !************************************************************************************* 1176 1205 IF (is_sequential) THEN 1177 CALL histwrite(nidct,cl_writ(8), itau_w,tab_flds(:,:,8), iim*(jjm+1),ndexct) 1178 CALL histwrite(nidct,cl_writ(9), itau_w,tab_flds(:,:,9), iim*(jjm+1),ndexct) 1179 CALL histwrite(nidct,cl_writ(10),itau_w,tab_flds(:,:,10),iim*(jjm+1),ndexct) 1180 CALL histwrite(nidct,cl_writ(11),itau_w,tab_flds(:,:,11),iim*(jjm+1),ndexct) 1181 CALL histwrite(nidct,cl_writ(12),itau_w,tab_flds(:,:,12),iim*(jjm+1),ndexct) 1182 CALL histwrite(nidct,cl_writ(13),itau_w,tab_flds(:,:,13),iim*(jjm+1),ndexct) 1183 CALL histwrite(nidct,cl_writ(14),itau_w,tab_flds(:,:,14),iim*(jjm+1),ndexct) 1184 CALL histwrite(nidct,cl_writ(15),itau_w,tab_flds(:,:,15),iim*(jjm+1),ndexct) 1185 CALL histwrite(nidct,cl_writ(16),itau_w,tab_flds(:,:,16),iim*(jjm+1),ndexct) 1186 CALL histwrite(nidct,cl_writ(17),itau_w,tab_flds(:,:,17),iim*(jjm+1),ndexct) 1187 CALL histwrite(nidct,cl_writ(18),itau_w,tab_flds(:,:,18),iim*(jjm+1),ndexct) 1188 CALL histwrite(nidct,cl_writ(19),itau_w,tab_flds(:,:,19),iim*(jjm+1),ndexct) 1189 CALL histwrite(nidct,cl_writ(1), itau_w,tab_flds(:,:,1), iim*(jjm+1),ndexct) 1190 CALL histwrite(nidct,cl_writ(2), itau_w,tab_flds(:,:,2), iim*(jjm+1),ndexct) 1191 CALL histwrite(nidct,cl_writ(3), itau_w,tab_flds(:,:,3), iim*(jjm+1),ndexct) 1192 CALL histwrite(nidct,cl_writ(4), itau_w,tab_flds(:,:,4), iim*(jjm+1),ndexct) 1193 CALL histwrite(nidct,cl_writ(5), itau_w,tab_flds(:,:,5), iim*(jjm+1),ndexct) 1194 CALL histwrite(nidct,cl_writ(6), itau_w,tab_flds(:,:,6), iim*(jjm+1),ndexct) 1195 CALL histwrite(nidct,cl_writ(7), itau_w,tab_flds(:,:,7), iim*(jjm+1),ndexct) 1196 CALL histsync(nidct) 1206 DO j=1,maxsend 1207 IF (infosend(j)%action) CALL histwrite(nidct,infosend(j)%name, itau_w, & 1208 tab_flds(:,:,j),iim*(jjm+1),ndexct) 1209 ENDDO 1197 1210 ENDIF 1198 1199 1200 1211 !************************************************************************************* 1201 1212 ! Send the table of all fields … … 1220 1231 DEALLOCATE(cpl_taux2D, cpl_tauy2D, cpl_windsp2D, stat=error ) 1221 1232 sum_error = sum_error + error 1233 1234 IF (cpl_carbon_cycle) THEN 1235 DEALLOCATE(cpl_atm_co22D, stat=error ) 1236 sum_error = sum_error + error 1237 END IF 1238 1222 1239 IF (sum_error /= 0) THEN 1223 1240 abort_message='Pb in deallocation of cpl_xxxx2D coupling variables' -
LMDZ4/branches/LMDZ4-dev/libf/phylmd/oasis.F90
r1133 r1152 22 22 23 23 IMPLICIT NONE 24 25 ! Maximum number of fields exchanged between ocean and atmosphere 26 INTEGER, PARAMETER :: jpmaxfld=40 27 ! Number of fields exchanged from atmosphere to ocean via flx.F 28 INTEGER, PARAMETER :: jpflda2o1=13 29 ! Number of fields exchanged from atmosphere to ocean via tau.F 30 INTEGER, PARAMETER :: jpflda2o2=6 31 ! Number of fields exchanged from ocean to atmosphere 32 INTEGER :: jpfldo2a 33 34 CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE :: cl_read 35 !$OMP THREADPRIVATE(cl_read) 36 CHARACTER (len=8), DIMENSION(jpmaxfld), PUBLIC, SAVE :: cl_writ 37 !$OMP THREADPRIVATE(cl_writ) 38 39 INTEGER, DIMENSION(jpmaxfld), SAVE, PRIVATE :: in_var_id 40 !$OMP THREADPRIVATE(in_var_id) 41 INTEGER, DIMENSION(jpflda2o1+jpflda2o2), SAVE, PRIVATE :: out_var_id 42 !$OMP THREADPRIVATE(out_var_id) 43 24 25 ! Id for fields sent to ocean 26 INTEGER, PARAMETER :: ids_tauxxu = 1 27 INTEGER, PARAMETER :: ids_tauyyu = 2 28 INTEGER, PARAMETER :: ids_tauzzu = 3 29 INTEGER, PARAMETER :: ids_tauxxv = 4 30 INTEGER, PARAMETER :: ids_tauyyv = 5 31 INTEGER, PARAMETER :: ids_tauzzv = 6 32 INTEGER, PARAMETER :: ids_windsp = 7 33 INTEGER, PARAMETER :: ids_shfice = 8 34 INTEGER, PARAMETER :: ids_shfoce = 9 35 INTEGER, PARAMETER :: ids_shftot = 10 36 INTEGER, PARAMETER :: ids_nsfice = 11 37 INTEGER, PARAMETER :: ids_nsfoce = 12 38 INTEGER, PARAMETER :: ids_nsftot = 13 39 INTEGER, PARAMETER :: ids_dflxdt = 14 40 INTEGER, PARAMETER :: ids_totrai = 15 41 INTEGER, PARAMETER :: ids_totsno = 16 42 INTEGER, PARAMETER :: ids_toteva = 17 43 INTEGER, PARAMETER :: ids_icevap = 18 44 INTEGER, PARAMETER :: ids_ocevap = 19 45 INTEGER, PARAMETER :: ids_calvin = 20 46 INTEGER, PARAMETER :: ids_liqrun = 21 47 INTEGER, PARAMETER :: ids_runcoa = 22 48 INTEGER, PARAMETER :: ids_rivflu = 23 49 INTEGER, PARAMETER :: ids_atmco2 = 24 50 INTEGER, PARAMETER :: maxsend = 24 ! Maximum number of fields to send 51 52 ! Id for fields received from ocean 53 INTEGER, PARAMETER :: idr_sisutw = 1 54 INTEGER, PARAMETER :: idr_icecov = 2 55 INTEGER, PARAMETER :: idr_icealw = 3 56 INTEGER, PARAMETER :: idr_icetem = 4 57 INTEGER, PARAMETER :: idr_curenx = 5 58 INTEGER, PARAMETER :: idr_cureny = 6 59 INTEGER, PARAMETER :: idr_curenz = 7 60 INTEGER, PARAMETER :: idr_oceco2 = 8 61 INTEGER, PARAMETER :: maxrecv = 8 ! Maximum number of fields to receive 62 63 64 TYPE, PUBLIC :: FLD_CPL ! Type for coupling field information 65 CHARACTER(len = 8) :: name ! Name of the coupling field 66 LOGICAL :: action ! To be exchanged or not 67 INTEGER :: nid ! Id of the field 68 END TYPE FLD_CPL 69 70 TYPE(FLD_CPL), DIMENSION(maxsend), PUBLIC :: infosend ! Information for sending coupling fields 71 TYPE(FLD_CPL), DIMENSION(maxrecv), PUBLIC :: inforecv ! Information for receiving coupling fields 72 44 73 LOGICAL :: cpl_current 74 LOGICAL :: cpl_carbon_cycle 45 75 46 76 #ifdef CPP_COUPLE … … 59 89 USE surface_data, ONLY : version_ocean 60 90 INCLUDE "dimensions.h" 91 INCLUDE "iniprint.h" 61 92 62 93 ! Local variables … … 69 100 INTEGER, DIMENSION(4) :: il_var_actual_shape 70 101 INTEGER :: il_var_type 71 INTEGER :: nuout = 672 102 INTEGER :: jf 73 103 CHARACTER (len = 6) :: clmodnam … … 75 105 CHARACTER (len = 80) :: abort_message 76 106 LOGICAL :: cpl_current_omp 107 LOGICAL :: cpl_carbon_cycle_omp 77 108 78 109 !* 1. Initializations 79 110 ! --------------- 80 111 !************************************************************************************ 81 WRITE( nuout,*) ' '82 WRITE( nuout,*) ' '83 WRITE( nuout,*) ' ROUTINE INICMA'84 WRITE( nuout,*) ' **************'85 WRITE( nuout,*) ' '86 WRITE( nuout,*) ' '112 WRITE(lunout,*) ' ' 113 WRITE(lunout,*) ' ' 114 WRITE(lunout,*) ' ROUTINE INICMA' 115 WRITE(lunout,*) ' **************' 116 WRITE(lunout,*) ' ' 117 WRITE(lunout,*) ' ' 87 118 88 119 ! … … 90 121 ! 91 122 clmodnam = 'lmdz.x' ! as in $NBMODEL in Cpl/Nam/namcouple.tmp 123 92 124 93 125 !************************************************************************************ … … 100 132 !$OMP BARRIER 101 133 cpl_current = cpl_current_omp 102 WRITE(nuout,*) 'Couple ocean currents, cpl_current = ',cpl_current 103 104 IF (cpl_current) THEN 105 jpfldo2a=7 106 ELSE 107 jpfldo2a=4 108 END IF 134 WRITE(lunout,*) 'Couple ocean currents, cpl_current = ',cpl_current 135 136 !************************************************************************************ 137 ! Define if coupling carbon cycle or not 138 !************************************************************************************ 139 !$OMP MASTER 140 cpl_carbon_cycle_omp = .FALSE. 141 CALL getin('cpl_carbon_cycle', cpl_carbon_cycle_omp) 142 !$OMP END MASTER 143 !$OMP BARRIER 144 cpl_carbon_cycle=cpl_carbon_cycle_omp 145 WRITE(lunout,*) 'Couple carbon cycle , cpl_carbon_cycle = ',cpl_carbon_cycle 146 147 !************************************************************************************ 148 ! Define coupling variables 149 !************************************************************************************ 150 151 ! Atmospheric variables to send 152 153 infosend(:)%action = .FALSE. 154 155 infosend(ids_tauxxu)%action = .TRUE. ; infosend(ids_tauxxu)%name = 'COTAUXXU' 156 infosend(ids_tauyyu)%action = .TRUE. ; infosend(ids_tauyyu)%name = 'COTAUYYU' 157 infosend(ids_tauzzu)%action = .TRUE. ; infosend(ids_tauzzu)%name = 'COTAUZZU' 158 infosend(ids_tauxxv)%action = .TRUE. ; infosend(ids_tauxxv)%name = 'COTAUXXV' 159 infosend(ids_tauyyv)%action = .TRUE. ; infosend(ids_tauyyv)%name = 'COTAUYYV' 160 infosend(ids_tauzzv)%action = .TRUE. ; infosend(ids_tauzzv)%name = 'COTAUZZV' 161 infosend(ids_windsp)%action = .TRUE. ; infosend(ids_windsp)%name = 'COWINDSP' 162 infosend(ids_shfice)%action = .TRUE. ; infosend(ids_shfice)%name = 'COSHFICE' 163 infosend(ids_nsfice)%action = .TRUE. ; infosend(ids_nsfice)%name = 'CONSFICE' 164 infosend(ids_dflxdt)%action = .TRUE. ; infosend(ids_dflxdt)%name = 'CODFLXDT' 165 infosend(ids_calvin)%action = .TRUE. ; infosend(ids_calvin)%name = 'COCALVIN' 166 167 168 IF (version_ocean=='nemo') THEN 169 infosend(ids_shftot)%action = .TRUE. ; infosend(ids_shftot)%name = 'COQSRMIX' 170 infosend(ids_nsftot)%action = .TRUE. ; infosend(ids_nsftot)%name = 'COQNSMIX' 171 infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOTRAI' 172 infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOTSNO' 173 infosend(ids_toteva)%action = .TRUE. ; infosend(ids_toteva)%name = 'COTOTEVA' 174 infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COICEVAP' 175 infosend(ids_liqrun)%action = .TRUE. ; infosend(ids_liqrun)%name = 'COLIQRUN' 176 IF (cpl_carbon_cycle) THEN 177 infosend(ids_atmco2)%action = .TRUE. ; infosend(ids_atmco2)%name = 'COATMCO2' 178 ENDIF 179 180 ELSE IF (version_ocean=='opa8') THEN 181 infosend(ids_shfoce)%action = .TRUE. ; infosend(ids_shfoce)%name = 'COSHFOCE' 182 infosend(ids_nsfoce)%action = .TRUE. ; infosend(ids_nsfoce)%name = 'CONSFOCE' 183 infosend(ids_icevap)%action = .TRUE. ; infosend(ids_icevap)%name = 'COTFSICE' 184 infosend(ids_ocevap)%action = .TRUE. ; infosend(ids_ocevap)%name = 'COTFSOCE' 185 infosend(ids_totrai)%action = .TRUE. ; infosend(ids_totrai)%name = 'COTOLPSU' 186 infosend(ids_totsno)%action = .TRUE. ; infosend(ids_totsno)%name = 'COTOSPSU' 187 infosend(ids_runcoa)%action = .TRUE. ; infosend(ids_runcoa)%name = 'CORUNCOA' 188 infosend(ids_rivflu)%action = .TRUE. ; infosend(ids_rivflu)%name = 'CORIVFLU' 189 ENDIF 190 191 ! Oceanic variables to receive 192 193 inforecv(:)%action = .FALSE. 194 195 inforecv(idr_sisutw)%action = .TRUE. ; inforecv(idr_sisutw)%name = 'SISUTESW' 196 inforecv(idr_icecov)%action = .TRUE. ; inforecv(idr_icecov)%name = 'SIICECOV' 197 inforecv(idr_icealw)%action = .TRUE. ; inforecv(idr_icealw)%name = 'SIICEALW' 198 inforecv(idr_icetem)%action = .TRUE. ; inforecv(idr_icetem)%name = 'SIICTEMW' 199 200 IF (cpl_current ) THEN 201 inforecv(idr_curenx)%action = .TRUE. ; inforecv(idr_curenx)%name = 'CURRENTX' 202 inforecv(idr_cureny)%action = .TRUE. ; inforecv(idr_cureny)%name = 'CURRENTY' 203 inforecv(idr_curenz)%action = .TRUE. ; inforecv(idr_curenz)%name = 'CURRENTZ' 204 ENDIF 205 206 IF (cpl_carbon_cycle ) THEN 207 inforecv(idr_oceco2)%action = .TRUE. ; inforecv(idr_oceco2)%name = 'SICO2FLX' 208 ENDIF 209 109 210 !************************************************************************************ 110 211 ! Here we go: psmile initialisation … … 117 218 CALL abort_gcm(modname,abort_message,1) 118 219 ELSE 119 WRITE( nuout,*) 'inicma : init psmile ok '220 WRITE(lunout,*) 'inicma : init psmile ok ' 120 221 ENDIF 121 222 ENDIF … … 130 231 131 232 IF (mpi_rank==mpi_size-1) ig_paral(3)=ig_paral(3)+iim-1 132 WRITE( nuout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3)233 WRITE(lunout,*) mpi_rank,'ig_paral--->',ig_paral(2),ig_paral(3) 133 234 134 235 ierror=PRISM_Ok … … 139 240 CALL abort_gcm(modname,abort_message,1) 140 241 ELSE 141 WRITE(nuout,*) 'inicma : decomposition domaine psmile ok ' 142 ENDIF 143 144 !************************************************************************************ 145 ! Field Declarations 146 !************************************************************************************ 147 ! Define symbolic name for fields exchanged from atmos to coupler, 148 ! must be the same as (1) of the field definition in namcouple: 149 ! 150 ! Initialization 151 cl_writ(:)='NOFLDATM' 152 153 cl_writ(1)='COTAUXXU' 154 cl_writ(2)='COTAUYYU' 155 cl_writ(3)='COTAUZZU' 156 cl_writ(4)='COTAUXXV' 157 cl_writ(5)='COTAUYYV' 158 cl_writ(6)='COTAUZZV' 159 cl_writ(7)='COWINDSP' 160 cl_writ(8)='COSHFICE' 161 cl_writ(10)='CONSFICE' 162 cl_writ(12)='CODFLXDT' 163 164 IF (version_ocean=='nemo') THEN 165 cl_writ(9)='COQSRMIX' 166 cl_writ(11)='COQNSMIX' 167 cl_writ(13)='COTOTRAI' 168 cl_writ(14)='COTOTSNO' 169 cl_writ(15)='COTOTEVA' 170 cl_writ(16)='COICEVAP' 171 cl_writ(17)='COCALVIN' 172 cl_writ(18)='COLIQRUN' 173 ELSE IF (version_ocean=='opa8') THEN 174 cl_writ(9)='COSHFOCE' 175 cl_writ(11)='CONSFOCE' 176 cl_writ(13)='COTFSICE' 177 cl_writ(14)='COTFSOCE' 178 cl_writ(15)='COTOLPSU' 179 cl_writ(16)='COTOSPSU' 180 cl_writ(17)='CORUNCOA' 181 cl_writ(18)='CORIVFLU' 182 cl_writ(19)='COCALVIN' 183 ENDIF 184 185 ! 186 ! Define symbolic name for fields exchanged from coupler to atmosphere, 187 ! must be the same as (2) of the field definition in namcouple: 188 ! 189 ! Initialization 190 cl_read(:)='NOFLDATM' 191 192 cl_read(1)='SISUTESW' 193 cl_read(2)='SIICECOV' 194 cl_read(3)='SIICEALW' 195 cl_read(4)='SIICTEMW' 196 197 IF (cpl_current) THEN 198 cl_read(5)='CURRENTX' 199 cl_read(6)='CURRENTY' 200 cl_read(7)='CURRENTZ' 201 END IF 242 WRITE(lunout,*) 'inicma : decomposition domaine psmile ok ' 243 ENDIF 202 244 203 245 il_var_nodims(1) = 2 … … 212 254 213 255 !************************************************************************************ 214 ! Oceanic Fields 215 !************************************************************************************ 216 DO jf=1, jpfldo2a 217 CALL prism_def_var_proto(in_var_id(jf), cl_read(jf), il_part_id, & 218 il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, & 219 ierror) 220 IF (ierror .NE. PRISM_Ok) THEN 221 abort_message=' Probleme init dans prism_def_var_proto ' 222 CALL abort_gcm(modname,abort_message,1) 256 ! Oceanic Fields to receive 257 ! Loop over all possible variables 258 !************************************************************************************ 259 DO jf=1, maxrecv 260 IF (inforecv(jf)%action) THEN 261 CALL prism_def_var_proto(inforecv(jf)%nid, inforecv(jf)%name, il_part_id, & 262 il_var_nodims, PRISM_In, il_var_actual_shape, il_var_type, & 263 ierror) 264 IF (ierror .NE. PRISM_Ok) THEN 265 WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',& 266 inforecv(jf)%name 267 abort_message=' Problem in call to prism_def_var_proto for fields to receive' 268 CALL abort_gcm(modname,abort_message,1) 269 ENDIF 223 270 ENDIF 224 271 END DO 225 226 !************************************************************************************ 227 ! Atmospheric Fields 228 !************************************************************************************ 229 DO jf=1, jpflda2o1+jpflda2o2 230 CALL prism_def_var_proto(out_var_id(jf), cl_writ(jf), il_part_id, & 231 il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, & 232 ierror) 233 IF (ierror .NE. PRISM_Ok) THEN 234 abort_message=' Probleme init dans prism_def_var_proto ' 235 CALL abort_gcm(modname,abort_message,1) 272 273 !************************************************************************************ 274 ! Atmospheric Fields to send 275 ! Loop over all possible variables 276 !************************************************************************************ 277 DO jf=1,maxsend 278 IF (infosend(jf)%action) THEN 279 CALL prism_def_var_proto(infosend(jf)%nid, infosend(jf)%name, il_part_id, & 280 il_var_nodims, PRISM_Out, il_var_actual_shape, il_var_type, & 281 ierror) 282 IF (ierror .NE. PRISM_Ok) THEN 283 WRITE(lunout,*) 'inicma : Problem with prism_def_var_proto for field : ',& 284 infosend(jf)%name 285 abort_message=' Problem in call to prism_def_var_proto for fields to send' 286 CALL abort_gcm(modname,abort_message,1) 287 ENDIF 236 288 ENDIF 237 289 END DO 238 290 239 291 !************************************************************************************ 240 292 ! End definition … … 242 294 CALL prism_enddef_proto(ierror) 243 295 IF (ierror .NE. PRISM_Ok) THEN 244 abort_message=' Problem e init dans prism_endef_proto'296 abort_message=' Problem in call to prism_endef_proto' 245 297 CALL abort_gcm(modname,abort_message,1) 246 298 ELSE 247 WRITE( nuout,*) 'inicma : endef psmile ok '299 WRITE(lunout,*) 'inicma : endef psmile ok ' 248 300 ENDIF 249 301 … … 261 313 ! 262 314 INCLUDE "dimensions.h" 315 INCLUDE "iniprint.h" 263 316 ! Input arguments 264 317 !************************************************************************************ … … 267 320 ! Output arguments 268 321 !************************************************************************************ 269 REAL, DIMENSION(iim, jj_nb, jpfldo2a), INTENT(OUT) :: tab_get322 REAL, DIMENSION(iim, jj_nb,maxrecv), INTENT(OUT) :: tab_get 270 323 271 324 ! Local variables 272 325 !************************************************************************************ 273 INTEGER :: nuout = 6 ! listing output unit274 326 INTEGER :: ierror, i 275 327 INTEGER :: istart,iend … … 279 331 280 332 !************************************************************************************ 281 WRITE ( nuout,*) ' '282 WRITE ( nuout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime283 WRITE ( nuout,*) ' '333 WRITE (lunout,*) ' ' 334 WRITE (lunout,*) 'Fromcpl: Reading fields from CPL, ktime=',ktime 335 WRITE (lunout,*) ' ' 284 336 285 337 istart=ii_begin … … 290 342 ENDIF 291 343 292 DO i = 1, jpfldo2a 293 field(:) = -99999. 294 CALL prism_get_proto(in_var_id(i), ktime, field(istart:iend), ierror) 295 tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/)) 344 DO i = 1, maxrecv 345 IF (inforecv(i)%action) THEN 346 field(:) = -99999. 347 CALL prism_get_proto(inforecv(i)%nid, ktime, field(istart:iend), ierror) 348 tab_get(:,:,i) = RESHAPE(field(:),(/iim,jj_nb/)) 296 349 297 IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. & 298 ierror.NE.PRISM_FromRest & 299 .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut & 300 .AND. ierror.NE.PRISM_FromRestOut) THEN 301 WRITE (nuout,*) cl_read(i), ktime 302 abort_message=' Probleme dans prism_get_proto ' 303 CALL abort_gcm(modname,abort_message,1) 304 ENDIF 350 IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Recvd .AND. & 351 ierror.NE.PRISM_FromRest & 352 .AND. ierror.NE.PRISM_Input .AND. ierror.NE.PRISM_RecvOut & 353 .AND. ierror.NE.PRISM_FromRestOut) THEN 354 WRITE (lunout,*) 'Error with receiving filed : ', inforecv(i)%name, ktime 355 abort_message=' Problem in prism_get_proto ' 356 CALL abort_gcm(modname,abort_message,1) 357 ENDIF 358 ENDIF 305 359 END DO 306 360 … … 321 375 ! 322 376 INCLUDE "dimensions.h" 377 INCLUDE "iniprint.h" 323 378 ! Input arguments 324 379 !************************************************************************************ 325 INTEGER, INTENT(IN) 326 LOGICAL, INTENT(IN) 327 REAL, DIMENSION(iim, jj_nb, jpflda2o1+jpflda2o2), INTENT(IN) :: tab_put380 INTEGER, INTENT(IN) :: ktime 381 LOGICAL, INTENT(IN) :: last 382 REAL, DIMENSION(iim, jj_nb, maxsend), INTENT(IN) :: tab_put 328 383 329 384 ! Local variables … … 332 387 INTEGER :: istart,iend 333 388 INTEGER :: wstart,wend 334 INTEGER, PARAMETER :: nuout = 6335 389 INTEGER :: ierror, i 336 390 REAL, DIMENSION(iim*jj_nb) :: field … … 341 395 checkout=.FALSE. 342 396 343 WRITE( nuout,*) ' '344 WRITE( nuout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime345 WRITE( nuout,*) 'last', last346 WRITE( nuout,*)397 WRITE(lunout,*) ' ' 398 WRITE(lunout,*) 'Intocpl: sending fields to CPL, ktime= ', ktime 399 WRITE(lunout,*) 'last = ', last 400 WRITE(lunout,*) 347 401 348 402 … … 360 414 IF (is_south_pole) wend=iend-iim+1 361 415 362 field = RESHAPE(tab_put(:,:,8),(/iim*jj_nb/)) 363 CALL writeField_phy("fsolice",field(wstart:wend),1) 364 field = RESHAPE(tab_put(:,:,9),(/iim*jj_nb/)) 365 CALL writeField_phy("fsolwat",field(wstart:wend),1) 366 field = RESHAPE(tab_put(:,:,10),(/iim*jj_nb/)) 367 CALL writeField_phy("fnsolice",field(wstart:wend),1) 368 field = RESHAPE(tab_put(:,:,11),(/iim*jj_nb/)) 369 CALL writeField_phy("fnsolwat",field(wstart:wend),1) 370 field = RESHAPE(tab_put(:,:,12),(/iim*jj_nb/)) 371 CALL writeField_phy("fnsicedt",field(wstart:wend),1) 372 field = RESHAPE(tab_put(:,:,13),(/iim*jj_nb/)) 373 CALL writeField_phy("evice",field(wstart:wend),1) 374 field = RESHAPE(tab_put(:,:,14),(/iim*jj_nb/)) 375 CALL writeField_phy("evwat",field(wstart:wend),1) 376 field = RESHAPE(tab_put(:,:,15),(/iim*jj_nb/)) 377 CALL writeField_phy("lpre",field(wstart:wend),1) 378 field = RESHAPE(tab_put(:,:,16),(/iim*jj_nb/)) 379 CALL writeField_phy("spre",field(wstart:wend),1) 380 field = RESHAPE(tab_put(:,:,17),(/iim*jj_nb/)) 381 CALL writeField_phy("dirunoff",field(wstart:wend),1) 382 field = RESHAPE(tab_put(:,:,18),(/iim*jj_nb/)) 383 CALL writeField_phy("rivrunoff",field(wstart:wend),1) 384 field = RESHAPE(tab_put(:,:,19),(/iim*jj_nb/)) 385 CALL writeField_phy("calving",field(wstart:wend),1) 386 field = RESHAPE(tab_put(:,:,1),(/iim*jj_nb/)) 387 CALL writeField_phy("tauxx_u",field(wstart:wend),1) 388 field = RESHAPE(tab_put(:,:,2),(/iim*jj_nb/)) 389 CALL writeField_phy("tauyy_u",field(wstart:wend),1) 390 field = RESHAPE(tab_put(:,:,3),(/iim*jj_nb/)) 391 CALL writeField_phy("tauzz_u",field(wstart:wend),1) 392 field = RESHAPE(tab_put(:,:,4),(/iim*jj_nb/)) 393 CALL writeField_phy("tauxx_v",field(wstart:wend),1) 394 field = RESHAPE(tab_put(:,:,5),(/iim*jj_nb/)) 395 CALL writeField_phy("tauyy_v",field(wstart:wend),1) 396 field = RESHAPE(tab_put(:,:,6),(/iim*jj_nb/)) 397 CALL writeField_phy("tauzz_v",field(wstart:wend),1) 398 field = RESHAPE(tab_put(:,:,7),(/iim*jj_nb/)) 399 CALL writeField_phy("windsp",field(wstart:wend),1) 400 ENDIF 401 416 DO i = 1, maxsend 417 IF (infosend(i)%action) THEN 418 field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) 419 CALL writefield_phy(infosend(i)%name,field(wstart:wend),1) 420 END IF 421 END DO 422 END IF 423 402 424 !************************************************************************************ 403 425 ! PRISM_PUT 404 426 !************************************************************************************ 405 427 406 DO i = 1, jpflda2o1+jpflda2o2 407 field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) 408 CALL prism_put_proto(out_var_id(i), ktime, field(istart:iend), ierror) 409 410 IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest & 411 .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. & 412 ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN 413 WRITE (nuout,*) cl_writ(i), ktime 414 abort_message=' Probleme dans prism_put_proto ' 415 CALL abort_gcm(modname,abort_message,1) 416 ENDIF 417 428 DO i = 1, maxsend 429 IF (infosend(i)%action) THEN 430 field = RESHAPE(tab_put(:,:,i),(/iim*jj_nb/)) 431 CALL prism_put_proto(infosend(i)%nid, ktime, field(istart:iend), ierror) 432 433 IF (ierror .NE. PRISM_Ok .AND. ierror.NE.PRISM_Sent .AND. ierror.NE.PRISM_ToRest & 434 .AND. ierror.NE.PRISM_LocTrans .AND. ierror.NE.PRISM_Output .AND. & 435 ierror.NE.PRISM_SentOut .AND. ierror.NE.PRISM_ToRestOut) THEN 436 WRITE (lunout,*) 'Error with sending field :', infosend(i)%name, ktime 437 abort_message=' Problem in prism_put_proto ' 438 CALL abort_gcm(modname,abort_message,1) 439 ENDIF 440 ENDIF 418 441 END DO 419 442 … … 427 450 CALL prism_terminate_proto(ierror) 428 451 IF (ierror .NE. PRISM_Ok) THEN 429 abort_message=' Problem e dansprism_terminate_proto '452 abort_message=' Problem in prism_terminate_proto ' 430 453 CALL abort_gcm(modname,abort_message,1) 431 454 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
